merged fork with new numeral representation (see NEWS)
authorhuffman
Sun, 25 Mar 2012 20:15:39 +0200
changeset 47108 2a1953f0d20d
parent 47107 35807a5d8dc2
child 47109 db5026631799
merged fork with new numeral representation (see NEWS)
NEWS
src/HOL/Algebra/Group.thy
src/HOL/Archimedean_Field.thy
src/HOL/Code_Evaluation.thy
src/HOL/Code_Numeral.thy
src/HOL/Codegenerator_Test/Generate_Pretty.thy
src/HOL/Complex.thy
src/HOL/Decision_Procs/Approximation.thy
src/HOL/Decision_Procs/Cooper.thy
src/HOL/Decision_Procs/Dense_Linear_Order.thy
src/HOL/Decision_Procs/Ferrack.thy
src/HOL/Decision_Procs/MIR.thy
src/HOL/Decision_Procs/Parametric_Ferrante_Rackoff.thy
src/HOL/Decision_Procs/cooper_tac.ML
src/HOL/Decision_Procs/ex/Dense_Linear_Order_Ex.thy
src/HOL/Decision_Procs/ferrack_tac.ML
src/HOL/Decision_Procs/mir_tac.ML
src/HOL/Deriv.thy
src/HOL/Divides.thy
src/HOL/Imperative_HOL/ex/Imperative_Quicksort.thy
src/HOL/Imperative_HOL/ex/Imperative_Reverse.thy
src/HOL/Imperative_HOL/ex/SatChecker.thy
src/HOL/Imperative_HOL/ex/Subarray.thy
src/HOL/Import/HOL_Light/HOLLightInt.thy
src/HOL/Int.thy
src/HOL/IsaMakefile
src/HOL/Library/BigO.thy
src/HOL/Library/Binomial.thy
src/HOL/Library/Bit.thy
src/HOL/Library/Cardinality.thy
src/HOL/Library/Code_Integer.thy
src/HOL/Library/Code_Nat.thy
src/HOL/Library/Code_Natural.thy
src/HOL/Library/Code_Prolog.thy
src/HOL/Library/Code_Real_Approx_By_Float.thy
src/HOL/Library/Efficient_Nat.thy
src/HOL/Library/Extended_Nat.thy
src/HOL/Library/Extended_Real.thy
src/HOL/Library/Float.thy
src/HOL/Library/Formal_Power_Series.thy
src/HOL/Library/Numeral_Type.thy
src/HOL/Library/Poly_Deriv.thy
src/HOL/Library/Polynomial.thy
src/HOL/Library/Predicate_Compile_Alternative_Defs.thy
src/HOL/Library/ROOT.ML
src/HOL/Library/Saturated.thy
src/HOL/Library/Sum_of_Squares/sum_of_squares.ML
src/HOL/Library/Target_Numeral.thy
src/HOL/List.thy
src/HOL/Matrix_LP/ComputeFloat.thy
src/HOL/Matrix_LP/ComputeNumeral.thy
src/HOL/Matrix_LP/SparseMatrix.thy
src/HOL/Metis_Examples/Big_O.thy
src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy
src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy
src/HOL/Multivariate_Analysis/Determinants.thy
src/HOL/Multivariate_Analysis/Norm_Arith.thy
src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy
src/HOL/Mutabelle/mutabelle_extra.ML
src/HOL/NSA/HyperDef.thy
src/HOL/NSA/NSA.thy
src/HOL/NSA/NSCA.thy
src/HOL/NSA/NSComplex.thy
src/HOL/NSA/StarDef.thy
src/HOL/Nat.thy
src/HOL/Nat_Numeral.thy
src/HOL/Nitpick_Examples/Integer_Nits.thy
src/HOL/Nominal/Nominal.thy
src/HOL/Num.thy
src/HOL/Number_Theory/Primes.thy
src/HOL/Numeral_Simprocs.thy
src/HOL/Parity.thy
src/HOL/Plain.thy
src/HOL/Predicate_Compile_Examples/Predicate_Compile_Tests.thy
src/HOL/Presburger.thy
src/HOL/Quickcheck_Examples/Quickcheck_Narrowing_Examples.thy
src/HOL/Quickcheck_Narrowing.thy
src/HOL/Quotient_Examples/Quotient_Rat.thy
src/HOL/RComplete.thy
src/HOL/Rat.thy
src/HOL/RealDef.thy
src/HOL/RealVector.thy
src/HOL/SMT_Examples/SMT_Examples.thy
src/HOL/SMT_Examples/SMT_Tests.thy
src/HOL/SPARK/SPARK.thy
src/HOL/Semiring_Normalization.thy
src/HOL/Series.thy
src/HOL/SetInterval.thy
src/HOL/Tools/Nitpick/nitpick.ML
src/HOL/Tools/Nitpick/nitpick_hol.ML
src/HOL/Tools/Predicate_Compile/predicate_compile_data.ML
src/HOL/Tools/Qelim/cooper.ML
src/HOL/Tools/SMT/smt_normalize.ML
src/HOL/Tools/SMT/z3_proof_tools.ML
src/HOL/Tools/arith_data.ML
src/HOL/Tools/float_syntax.ML
src/HOL/Tools/hologic.ML
src/HOL/Tools/int_arith.ML
src/HOL/Tools/lin_arith.ML
src/HOL/Tools/nat_numeral_simprocs.ML
src/HOL/Tools/numeral.ML
src/HOL/Tools/numeral_simprocs.ML
src/HOL/Tools/numeral_syntax.ML
src/HOL/Tools/semiring_normalizer.ML
src/HOL/Transcendental.thy
src/HOL/Word/Bit_Int.thy
src/HOL/Word/Bit_Representation.thy
src/HOL/Word/Bool_List_Representation.thy
src/HOL/Word/Misc_Numeric.thy
src/HOL/Word/Word.thy
src/HOL/ex/Arith_Examples.thy
src/HOL/ex/Code_Nat_examples.thy
src/HOL/ex/Dedekind_Real.thy
src/HOL/ex/Efficient_Nat_examples.thy
src/HOL/ex/Groebner_Examples.thy
src/HOL/ex/Numeral_Representation.thy
src/HOL/ex/ROOT.ML
src/HOL/ex/ReflectionEx.thy
src/HOL/ex/Simproc_Tests.thy
--- a/NEWS	Sat Mar 24 16:27:04 2012 +0100
+++ b/NEWS	Sun Mar 25 20:15:39 2012 +0200
@@ -90,6 +90,30 @@
 
 *** HOL ***
 
+* The representation of numerals has changed. We now have a datatype
+"num" representing strictly positive binary numerals, along with
+functions "numeral :: num => 'a" and "neg_numeral :: num => 'a" to
+represent positive and negated numeric literals, respectively. (See
+definitions in Num.thy.) Potential INCOMPATIBILITY; some user theories
+may require adaptations:
+
+  - Theorems with number_ring or number_semiring constraints: These
+    classes are gone; use comm_ring_1 or comm_semiring_1 instead.
+
+  - Theories defining numeric types: Remove number, number_semiring,
+    and number_ring instances. Defer all theorems about numerals until
+    after classes one and semigroup_add have been instantiated.
+
+  - Numeral-only simp rules: Replace each rule having a "number_of v"
+    pattern with two copies, one for numeral and one for neg_numeral.
+
+  - Theorems about subclasses of semiring_1 or ring_1: These classes
+    automatically support numerals now, so more simp rules and
+    simprocs may now apply within the proof.
+
+  - Definitions and theorems using old constructors Pls/Min/Bit0/Bit1:
+    Redefine using other integer operations.
+
 * Type 'a set is now a proper type constructor (just as before
 Isabelle2008).  Definitions mem_def and Collect_def have disappeared.
 Non-trivial INCOMPATIBILITY.  For developments keeping predicates and
--- a/src/HOL/Algebra/Group.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Algebra/Group.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -30,7 +30,7 @@
   where "Units G = {y. y \<in> carrier G & (\<exists>x \<in> carrier G. x \<otimes>\<^bsub>G\<^esub> y = \<one>\<^bsub>G\<^esub> & y \<otimes>\<^bsub>G\<^esub> x = \<one>\<^bsub>G\<^esub>)}"
 
 consts
-  pow :: "[('a, 'm) monoid_scheme, 'a, 'b::number] => 'a"  (infixr "'(^')\<index>" 75)
+  pow :: "[('a, 'm) monoid_scheme, 'a, 'b::semiring_1] => 'a"  (infixr "'(^')\<index>" 75)
 
 overloading nat_pow == "pow :: [_, 'a, nat] => 'a"
 begin
--- a/src/HOL/Archimedean_Field.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Archimedean_Field.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -12,7 +12,7 @@
 
 text {* Archimedean fields have no infinite elements. *}
 
-class archimedean_field = linordered_field + number_ring +
+class archimedean_field = linordered_field +
   assumes ex_le_of_int: "\<exists>z. x \<le> of_int z"
 
 lemma ex_less_of_int:
@@ -202,8 +202,11 @@
 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 floor_numeral [simp]: "floor (numeral v) = numeral v"
+  using floor_of_int [of "numeral v"] by simp
+
+lemma floor_neg_numeral [simp]: "floor (neg_numeral v) = neg_numeral v"
+  using floor_of_int [of "neg_numeral v"] by simp
 
 lemma zero_le_floor [simp]: "0 \<le> floor x \<longleftrightarrow> 0 \<le> x"
   by (simp add: le_floor_iff)
@@ -211,7 +214,12 @@
 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"
+lemma numeral_le_floor [simp]:
+  "numeral v \<le> floor x \<longleftrightarrow> numeral v \<le> x"
+  by (simp add: le_floor_iff)
+
+lemma neg_numeral_le_floor [simp]:
+  "neg_numeral v \<le> floor x \<longleftrightarrow> neg_numeral v \<le> x"
   by (simp add: le_floor_iff)
 
 lemma zero_less_floor [simp]: "0 < floor x \<longleftrightarrow> 1 \<le> x"
@@ -220,8 +228,12 @@
 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"
+lemma numeral_less_floor [simp]:
+  "numeral v < floor x \<longleftrightarrow> numeral v + 1 \<le> x"
+  by (simp add: less_floor_iff)
+
+lemma neg_numeral_less_floor [simp]:
+  "neg_numeral v < floor x \<longleftrightarrow> neg_numeral v + 1 \<le> x"
   by (simp add: less_floor_iff)
 
 lemma floor_le_zero [simp]: "floor x \<le> 0 \<longleftrightarrow> x < 1"
@@ -230,8 +242,12 @@
 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"
+lemma floor_le_numeral [simp]:
+  "floor x \<le> numeral v \<longleftrightarrow> x < numeral v + 1"
+  by (simp add: floor_le_iff)
+
+lemma floor_le_neg_numeral [simp]:
+  "floor x \<le> neg_numeral v \<longleftrightarrow> x < neg_numeral v + 1"
   by (simp add: floor_le_iff)
 
 lemma floor_less_zero [simp]: "floor x < 0 \<longleftrightarrow> x < 0"
@@ -240,8 +256,12 @@
 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"
+lemma floor_less_numeral [simp]:
+  "floor x < numeral v \<longleftrightarrow> x < numeral v"
+  by (simp add: floor_less_iff)
+
+lemma floor_less_neg_numeral [simp]:
+  "floor x < neg_numeral v \<longleftrightarrow> x < neg_numeral v"
   by (simp add: floor_less_iff)
 
 text {* Addition and subtraction of integers *}
@@ -249,9 +269,13 @@
 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_numeral [simp]:
+    "floor (x + numeral v) = floor x + numeral v"
+  using floor_add_of_int [of x "numeral v"] by simp
+
+lemma floor_add_neg_numeral [simp]:
+    "floor (x + neg_numeral v) = floor x + neg_numeral v"
+  using floor_add_of_int [of x "neg_numeral v"] by simp
 
 lemma floor_add_one [simp]: "floor (x + 1) = floor x + 1"
   using floor_add_of_int [of x 1] by simp
@@ -259,9 +283,13 @@
 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_numeral [simp]:
+  "floor (x - numeral v) = floor x - numeral v"
+  using floor_diff_of_int [of x "numeral v"] by simp
+
+lemma floor_diff_neg_numeral [simp]:
+  "floor (x - neg_numeral v) = floor x - neg_numeral v"
+  using floor_diff_of_int [of x "neg_numeral v"] by simp
 
 lemma floor_diff_one [simp]: "floor (x - 1) = floor x - 1"
   using floor_diff_of_int [of x 1] by simp
@@ -320,8 +348,11 @@
 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_numeral [simp]: "ceiling (numeral v) = numeral v"
+  using ceiling_of_int [of "numeral v"] by simp
+
+lemma ceiling_neg_numeral [simp]: "ceiling (neg_numeral v) = neg_numeral v"
+  using ceiling_of_int [of "neg_numeral v"] by simp
 
 lemma ceiling_le_zero [simp]: "ceiling x \<le> 0 \<longleftrightarrow> x \<le> 0"
   by (simp add: ceiling_le_iff)
@@ -329,8 +360,12 @@
 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"
+lemma ceiling_le_numeral [simp]:
+  "ceiling x \<le> numeral v \<longleftrightarrow> x \<le> numeral v"
+  by (simp add: ceiling_le_iff)
+
+lemma ceiling_le_neg_numeral [simp]:
+  "ceiling x \<le> neg_numeral v \<longleftrightarrow> x \<le> neg_numeral v"
   by (simp add: ceiling_le_iff)
 
 lemma ceiling_less_zero [simp]: "ceiling x < 0 \<longleftrightarrow> x \<le> -1"
@@ -339,8 +374,12 @@
 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"
+lemma ceiling_less_numeral [simp]:
+  "ceiling x < numeral v \<longleftrightarrow> x \<le> numeral v - 1"
+  by (simp add: ceiling_less_iff)
+
+lemma ceiling_less_neg_numeral [simp]:
+  "ceiling x < neg_numeral v \<longleftrightarrow> x \<le> neg_numeral v - 1"
   by (simp add: ceiling_less_iff)
 
 lemma zero_le_ceiling [simp]: "0 \<le> ceiling x \<longleftrightarrow> -1 < x"
@@ -349,8 +388,12 @@
 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"
+lemma numeral_le_ceiling [simp]:
+  "numeral v \<le> ceiling x \<longleftrightarrow> numeral v - 1 < x"
+  by (simp add: le_ceiling_iff)
+
+lemma neg_numeral_le_ceiling [simp]:
+  "neg_numeral v \<le> ceiling x \<longleftrightarrow> neg_numeral v - 1 < x"
   by (simp add: le_ceiling_iff)
 
 lemma zero_less_ceiling [simp]: "0 < ceiling x \<longleftrightarrow> 0 < x"
@@ -359,8 +402,12 @@
 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"
+lemma numeral_less_ceiling [simp]:
+  "numeral v < ceiling x \<longleftrightarrow> numeral v < x"
+  by (simp add: less_ceiling_iff)
+
+lemma neg_numeral_less_ceiling [simp]:
+  "neg_numeral v < ceiling x \<longleftrightarrow> neg_numeral v < x"
   by (simp add: less_ceiling_iff)
 
 text {* Addition and subtraction of integers *}
@@ -368,9 +415,13 @@
 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_numeral [simp]:
+    "ceiling (x + numeral v) = ceiling x + numeral v"
+  using ceiling_add_of_int [of x "numeral v"] by simp
+
+lemma ceiling_add_neg_numeral [simp]:
+    "ceiling (x + neg_numeral v) = ceiling x + neg_numeral v"
+  using ceiling_add_of_int [of x "neg_numeral v"] by simp
 
 lemma ceiling_add_one [simp]: "ceiling (x + 1) = ceiling x + 1"
   using ceiling_add_of_int [of x 1] by simp
@@ -378,9 +429,13 @@
 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_numeral [simp]:
+  "ceiling (x - numeral v) = ceiling x - numeral v"
+  using ceiling_diff_of_int [of x "numeral v"] by simp
+
+lemma ceiling_diff_neg_numeral [simp]:
+  "ceiling (x - neg_numeral v) = ceiling x - neg_numeral v"
+  using ceiling_diff_of_int [of x "neg_numeral v"] by simp
 
 lemma ceiling_diff_one [simp]: "ceiling (x - 1) = ceiling x - 1"
   using ceiling_diff_of_int [of x 1] by simp
--- a/src/HOL/Code_Evaluation.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Code_Evaluation.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -146,33 +146,29 @@
   "term_of_num_semiring two = (\<lambda>_. dummy_term)"
 
 lemma (in term_syntax) term_of_num_semiring_code [code]:
-  "term_of_num_semiring two k = (if k = 0 then termify Int.Pls
+  "term_of_num_semiring two k = (
+    if k = 1 then termify Num.One
     else (if k mod two = 0
-      then termify Int.Bit0 <\<cdot>> term_of_num_semiring two (k div two)
-      else termify Int.Bit1 <\<cdot>> term_of_num_semiring two (k div two)))"
-  by (auto simp add: term_of_anything Const_def App_def term_of_num_semiring_def Let_def)
+      then termify Num.Bit0 <\<cdot>> term_of_num_semiring two (k div two)
+      else termify Num.Bit1 <\<cdot>> term_of_num_semiring two (k div two)))"
+  by (auto simp add: term_of_anything Const_def App_def term_of_num_semiring_def)
 
 lemma (in term_syntax) term_of_nat_code [code]:
-  "term_of (n::nat) = termify (number_of :: int \<Rightarrow> nat) <\<cdot>> term_of_num_semiring (2::nat) n"
+  "term_of (n::nat) = (
+    if n = 0 then termify (0 :: nat)
+    else termify (numeral :: num \<Rightarrow> nat) <\<cdot>> term_of_num_semiring (2::nat) n)"
   by (simp only: term_of_anything)
 
 lemma (in term_syntax) term_of_code_numeral_code [code]:
-  "term_of (k::code_numeral) = termify (number_of :: int \<Rightarrow> code_numeral) <\<cdot>> term_of_num_semiring (2::code_numeral) k"
+  "term_of (k::code_numeral) = (
+    if k = 0 then termify (0 :: code_numeral)
+    else termify (numeral :: num \<Rightarrow> code_numeral) <\<cdot>> term_of_num_semiring (2::code_numeral) k)"
   by (simp only: term_of_anything)
 
-definition term_of_num_ring :: "'a\<Colon>ring_div \<Rightarrow> 'a \<Rightarrow> term" where
-  "term_of_num_ring two = (\<lambda>_. dummy_term)"
-
-lemma (in term_syntax) term_of_num_ring_code [code]:
-  "term_of_num_ring two k = (if k = 0 then termify Int.Pls
-    else if k = -1 then termify Int.Min
-    else if k mod two = 0 then termify Int.Bit0 <\<cdot>> term_of_num_ring two (k div two)
-    else termify Int.Bit1 <\<cdot>> term_of_num_ring two (k div two))"
-  by (auto simp add: term_of_anything Const_def App_def term_of_num_ring_def Let_def)
-
 lemma (in term_syntax) term_of_int_code [code]:
   "term_of (k::int) = (if k = 0 then termify (0 :: int)
-    else termify (number_of :: int \<Rightarrow> int) <\<cdot>> term_of_num_ring (2::int) k)"
+    else if k < 0 then termify (neg_numeral :: num \<Rightarrow> int) <\<cdot>> term_of_num_semiring (2::int) (- k)
+    else termify (numeral :: num \<Rightarrow> int) <\<cdot>> term_of_num_semiring (2::int) k)"
   by (simp only: term_of_anything)
 
 
@@ -201,6 +197,6 @@
 
 
 hide_const dummy_term valapp
-hide_const (open) Const App Abs Free termify valtermify term_of term_of_num_semiring term_of_num_ring tracing
+hide_const (open) Const App Abs Free termify valtermify term_of term_of_num_semiring tracing
 
 end
--- a/src/HOL/Code_Numeral.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Code_Numeral.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -123,25 +123,6 @@
   by (rule equal_refl)
 
 
-subsection {* Code numerals as datatype of ints *}
-
-instantiation code_numeral :: number
-begin
-
-definition
-  "number_of = of_nat o nat"
-
-instance ..
-
-end
-
-lemma nat_of_number [simp]:
-  "nat_of (number_of k) = number_of k"
-  by (simp add: number_of_code_numeral_def nat_number_of_def number_of_is_id)
-
-code_datatype "number_of \<Colon> int \<Rightarrow> code_numeral"
-
-
 subsection {* Basic arithmetic *}
 
 instantiation code_numeral :: "{minus, linordered_semidom, semiring_div, linorder}"
@@ -176,16 +157,17 @@
 
 end
 
-lemma zero_code_numeral_code [code]:
-  "(0\<Colon>code_numeral) = Numeral0"
-  by (simp add: number_of_code_numeral_def Pls_def)
+lemma nat_of_numeral [simp]: "nat_of (numeral k) = numeral k"
+  by (induct k rule: num_induct) (simp_all add: numeral_inc)
 
-lemma [code_abbrev]: "Numeral0 = (0\<Colon>code_numeral)"
-  using zero_code_numeral_code ..
+definition Num :: "num \<Rightarrow> code_numeral"
+  where [simp, code_abbrev]: "Num = numeral"
+
+code_datatype "0::code_numeral" Num
 
 lemma one_code_numeral_code [code]:
   "(1\<Colon>code_numeral) = Numeral1"
-  by (simp add: number_of_code_numeral_def Pls_def Bit1_def)
+  by simp
 
 lemma [code_abbrev]: "Numeral1 = (1\<Colon>code_numeral)"
   using one_code_numeral_code ..
@@ -194,15 +176,8 @@
   "of_nat n + of_nat m = of_nat (n + m)"
   by simp
 
-definition subtract :: "code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral" where
-  [simp]: "subtract = minus"
-
-lemma subtract_code [code nbe]:
-  "subtract (of_nat n) (of_nat m) = of_nat (n - m)"
-  by simp
-
-lemma minus_code_numeral_code [code]:
-  "minus = subtract"
+lemma minus_code_numeral_code [code nbe]:
+  "of_nat n - of_nat m = of_nat (n - m)"
   by simp
 
 lemma times_code_numeral_code [code nbe]:
@@ -281,7 +256,7 @@
 qed
 
 
-hide_const (open) of_nat nat_of Suc subtract int_of
+hide_const (open) of_nat nat_of Suc int_of
 
 
 subsection {* Code generator setup *}
@@ -298,15 +273,21 @@
   (Haskell -)
 
 setup {*
-  Numeral.add_code @{const_name number_code_numeral_inst.number_of_code_numeral}
+  Numeral.add_code @{const_name Num}
     false Code_Printer.literal_naive_numeral "SML"
-  #> fold (Numeral.add_code @{const_name number_code_numeral_inst.number_of_code_numeral}
+  #> fold (Numeral.add_code @{const_name Num}
     false Code_Printer.literal_numeral) ["OCaml", "Haskell", "Scala"]
 *}
 
 code_reserved SML Int int
 code_reserved Eval Integer
 
+code_const "0::code_numeral"
+  (SML "0")
+  (OCaml "Big'_int.zero'_big'_int")
+  (Haskell "0")
+  (Scala "BigInt(0)")
+
 code_const "plus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   (SML "Int.+/ ((_),/ (_))")
   (OCaml "Big'_int.add'_big'_int")
@@ -314,12 +295,12 @@
   (Scala infixl 7 "+")
   (Eval infixl 8 "+")
 
-code_const "Code_Numeral.subtract \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
-  (SML "Int.max/ (_/ -/ _,/ 0 : int)")
-  (OCaml "Big'_int.max'_big'_int/ (Big'_int.sub'_big'_int/ _/ _)/ Big'_int.zero'_big'_int")
-  (Haskell "max/ (_/ -/ _)/ (0 :: Integer)")
+code_const "minus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
+  (SML "Int.max/ (0 : int,/ Int.-/ ((_),/ (_)))")
+  (OCaml "Big'_int.max'_big'_int/ Big'_int.zero'_big'_int/ (Big'_int.sub'_big'_int/ _/ _)")
+  (Haskell "max/ (0 :: Integer)/ (_/ -/ _)")
   (Scala "!(_/ -/ _).max(0)")
-  (Eval "Integer.max/ (_/ -/ _)/ 0")
+  (Eval "Integer.max/ 0/ (_/ -/ _)")
 
 code_const "times \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   (SML "Int.*/ ((_),/ (_))")
--- a/src/HOL/Codegenerator_Test/Generate_Pretty.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Codegenerator_Test/Generate_Pretty.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -10,9 +10,8 @@
 lemma [code, code del]: "nat_of_char = nat_of_char" ..
 lemma [code, code del]: "char_of_nat = char_of_nat" ..
 
-declare Quickcheck_Narrowing.zero_code_int_code[code del]
-declare Quickcheck_Narrowing.one_code_int_code[code del]
-declare Quickcheck_Narrowing.int_of_code[code del]
+declare Quickcheck_Narrowing.one_code_int_code [code del]
+declare Quickcheck_Narrowing.int_of_code [code del]
 
 subsection {* Check whether generated code compiles *}
 
--- a/src/HOL/Complex.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Complex.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -151,17 +151,6 @@
 
 subsection {* Numerals and Arithmetic *}
 
-instantiation complex :: number_ring
-begin
-
-definition complex_number_of_def:
-  "number_of w = (of_int w \<Colon> complex)"
-
-instance
-  by intro_classes (simp only: complex_number_of_def)
-
-end
-
 lemma complex_Re_of_nat [simp]: "Re (of_nat n) = of_nat n"
   by (induct n) simp_all
 
@@ -174,14 +163,24 @@
 lemma complex_Im_of_int [simp]: "Im (of_int z) = 0"
   by (cases z rule: int_diff_cases) simp
 
-lemma complex_Re_number_of [simp]: "Re (number_of v) = number_of v"
-  unfolding number_of_eq by (rule complex_Re_of_int)
+lemma complex_Re_numeral [simp]: "Re (numeral v) = numeral v"
+  using complex_Re_of_int [of "numeral v"] by simp
+
+lemma complex_Re_neg_numeral [simp]: "Re (neg_numeral v) = neg_numeral v"
+  using complex_Re_of_int [of "neg_numeral v"] by simp
+
+lemma complex_Im_numeral [simp]: "Im (numeral v) = 0"
+  using complex_Im_of_int [of "numeral v"] by simp
 
-lemma complex_Im_number_of [simp]: "Im (number_of v) = 0"
-  unfolding number_of_eq by (rule complex_Im_of_int)
+lemma complex_Im_neg_numeral [simp]: "Im (neg_numeral v) = 0"
+  using complex_Im_of_int [of "neg_numeral v"] by simp
 
-lemma Complex_eq_number_of [simp]:
-  "(Complex a b = number_of w) = (a = number_of w \<and> b = 0)"
+lemma Complex_eq_numeral [simp]:
+  "(Complex a b = numeral w) = (a = numeral w \<and> b = 0)"
+  by (simp add: complex_eq_iff)
+
+lemma Complex_eq_neg_numeral [simp]:
+  "(Complex a b = neg_numeral w) = (a = neg_numeral w \<and> b = 0)"
   by (simp add: complex_eq_iff)
 
 
@@ -421,7 +420,10 @@
 lemma complex_i_not_one [simp]: "ii \<noteq> 1"
   by (simp add: complex_eq_iff)
 
-lemma complex_i_not_number_of [simp]: "ii \<noteq> number_of w"
+lemma complex_i_not_numeral [simp]: "ii \<noteq> numeral w"
+  by (simp add: complex_eq_iff)
+
+lemma complex_i_not_neg_numeral [simp]: "ii \<noteq> neg_numeral w"
   by (simp add: complex_eq_iff)
 
 lemma i_mult_Complex [simp]: "ii * Complex a b = Complex (- b) a"
@@ -505,7 +507,10 @@
 lemma complex_cnj_of_int [simp]: "cnj (of_int z) = of_int z"
   by (simp add: complex_eq_iff)
 
-lemma complex_cnj_number_of [simp]: "cnj (number_of w) = number_of w"
+lemma complex_cnj_numeral [simp]: "cnj (numeral w) = numeral w"
+  by (simp add: complex_eq_iff)
+
+lemma complex_cnj_neg_numeral [simp]: "cnj (neg_numeral w) = neg_numeral w"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_scaleR: "cnj (scaleR r x) = scaleR r (cnj x)"
@@ -686,10 +691,10 @@
   "(of_nat n :: 'a::linordered_idom) < of_int x \<longleftrightarrow> int n < x"
   by (metis of_int_of_nat_eq of_int_less_iff)
 
-lemma real_of_nat_less_number_of_iff [simp]: (* TODO: move *)
-  "real (n::nat) < number_of w \<longleftrightarrow> n < number_of w"
-  unfolding real_of_nat_def nat_number_of_def number_of_eq
-  by (simp add: of_nat_less_of_int_iff zless_nat_eq_int_zless)
+lemma real_of_nat_less_numeral_iff [simp]: (* TODO: move *)
+  "real (n::nat) < numeral w \<longleftrightarrow> n < numeral w"
+  using of_nat_less_of_int_iff [of n "numeral w", where 'a=real]
+  by (simp add: real_of_nat_def zless_nat_eq_int_zless [symmetric])
 
 lemma arg_unique:
   assumes "sgn z = cis x" and "-pi < x" and "x \<le> pi"
--- a/src/HOL/Decision_Procs/Approximation.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Decision_Procs/Approximation.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -1350,7 +1350,7 @@
       also have "\<dots> \<le> cos ((?ux - 2 * ?lpi))"
         using cos_monotone_minus_pi_0'[OF pi_x x_le_ux ux_0]
         by (simp only: real_of_float_minus real_of_int_minus real_of_one
-            number_of_Min diff_minus mult_minus_left mult_1_left)
+            minus_one [symmetric] diff_minus mult_minus_left mult_1_left)
       also have "\<dots> = cos ((- (?ux - 2 * ?lpi)))"
         unfolding real_of_float_minus cos_minus ..
       also have "\<dots> \<le> (ub_cos prec (- (?ux - 2 * ?lpi)))"
@@ -1394,7 +1394,7 @@
       also have "\<dots> \<le> cos ((?lx + 2 * ?lpi))"
         using cos_monotone_0_pi'[OF lx_0 lx_le_x pi_x]
         by (simp only: real_of_float_minus real_of_int_minus real_of_one
-          number_of_Min diff_minus mult_minus_left mult_1_left)
+          minus_one [symmetric] diff_minus mult_minus_left mult_1_left)
       also have "\<dots> \<le> (ub_cos prec (?lx + 2 * ?lpi))"
         using lb_cos[OF lx_0 pi_lx] by simp
       finally show ?thesis unfolding u by (simp add: real_of_float_max)
@@ -2117,7 +2117,8 @@
 lemma interpret_floatarith_num:
   shows "interpret_floatarith (Num (Float 0 0)) vs = 0"
   and "interpret_floatarith (Num (Float 1 0)) vs = 1"
-  and "interpret_floatarith (Num (Float (number_of a) 0)) vs = number_of a" by auto
+  and "interpret_floatarith (Num (Float (numeral a) 0)) vs = numeral a"
+  and "interpret_floatarith (Num (Float (neg_numeral a) 0)) vs = neg_numeral a" by auto
 
 subsection "Implement approximation function"
 
--- a/src/HOL/Decision_Procs/Cooper.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Decision_Procs/Cooper.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -1883,7 +1883,8 @@
       | SOME n => @{code Bound} n)
   | num_of_term vs @{term "0::int"} = @{code C} 0
   | num_of_term vs @{term "1::int"} = @{code C} 1
-  | num_of_term vs (@{term "number_of :: int \<Rightarrow> int"} $ t) = @{code C} (HOLogic.dest_numeral t)
+  | num_of_term vs (@{term "numeral :: _ \<Rightarrow> int"} $ t) = @{code C} (HOLogic.dest_num t)
+  | num_of_term vs (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t) = @{code C} (~(HOLogic.dest_num t))
   | num_of_term vs (Bound i) = @{code Bound} i
   | num_of_term vs (@{term "uminus :: int \<Rightarrow> int"} $ t') = @{code Neg} (num_of_term vs t')
   | num_of_term vs (@{term "op + :: int \<Rightarrow> int \<Rightarrow> int"} $ t1 $ t2) =
--- a/src/HOL/Decision_Procs/Dense_Linear_Order.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Decision_Procs/Dense_Linear_Order.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -636,14 +636,8 @@
 
 interpretation class_dense_linordered_field: constr_dense_linorder
  "op <=" "op <"
-   "\<lambda> x y. 1/2 * ((x::'a::{linordered_field,number_ring}) + y)"
-proof (unfold_locales, dlo, dlo, auto)
-  fix x y::'a assume lt: "x < y"
-  from  less_half_sum[OF lt] show "x < (x + y) /2" by simp
-next
-  fix x y::'a assume lt: "x < y"
-  from  gt_half_sum[OF lt] show "(x + y) /2 < y" by simp
-qed
+   "\<lambda> x y. 1/2 * ((x::'a::{linordered_field}) + y)"
+by (unfold_locales, dlo, dlo, auto)
 
 declaration{*
 let
--- a/src/HOL/Decision_Procs/Ferrack.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Decision_Procs/Ferrack.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -1732,7 +1732,7 @@
          (set U \<times> set U)"using mnz nnz th  
     apply (auto simp add: th add_divide_distrib algebra_simps split_def image_def)
     by (rule_tac x="(s,m)" in bexI,simp_all) 
-  (rule_tac x="(t,n)" in bexI,simp_all)
+  (rule_tac x="(t,n)" in bexI,simp_all add: mult_commute)
 next
   fix t n s m
   assume tnU: "(t,n) \<in> set U" and smU:"(s,m) \<in> set U" 
@@ -1937,11 +1937,12 @@
   | num_of_term vs (@{term "op * :: real \<Rightarrow> real \<Rightarrow> real"} $ t1 $ t2) = (case num_of_term vs t1
      of @{code C} i => @{code Mul} (i, num_of_term vs t2)
       | _ => error "num_of_term: unsupported multiplication")
-  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "number_of :: int \<Rightarrow> int"} $ t')) =
-     @{code C} (HOLogic.dest_numeral t')
-  | num_of_term vs (@{term "number_of :: int \<Rightarrow> real"} $ t') =
-     @{code C} (HOLogic.dest_numeral t')
-  | num_of_term vs t = error ("num_of_term: unknown term");
+  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ t') =
+     (@{code C} (snd (HOLogic.dest_number t'))
+       handle TERM _ => error ("num_of_term: unknown term"))
+  | num_of_term vs t' =
+     (@{code C} (snd (HOLogic.dest_number t'))
+       handle TERM _ => error ("num_of_term: unknown term"));
 
 fun fm_of_term vs @{term True} = @{code T}
   | fm_of_term vs @{term False} = @{code F}
--- a/src/HOL/Decision_Procs/MIR.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Decision_Procs/MIR.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -4901,7 +4901,7 @@
          (set U \<times> set U)"using mnz nnz th  
     apply (auto simp add: th add_divide_distrib algebra_simps split_def image_def)
     by (rule_tac x="(s,m)" in bexI,simp_all) 
-  (rule_tac x="(t,n)" in bexI,simp_all)
+  (rule_tac x="(t,n)" in bexI,simp_all add: mult_commute)
 next
   fix t n s m
   assume tnU: "(t,n) \<in> set U" and smU:"(s,m) \<in> set U" 
@@ -5536,14 +5536,18 @@
       (case (num_of_term vs t1)
        of @{code C} i => @{code Mul} (i, num_of_term vs t2)
         | _ => error "num_of_term: unsupported Multiplication")
-  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "number_of :: int \<Rightarrow> int"} $ t')) =
-      @{code C} (HOLogic.dest_numeral t')
+  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "numeral :: _ \<Rightarrow> int"} $ t')) =
+      @{code C} (HOLogic.dest_num t')
+  | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t')) =
+      @{code C} (~ (HOLogic.dest_num t'))
   | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "floor :: real \<Rightarrow> int"} $ t')) =
       @{code Floor} (num_of_term vs t')
   | num_of_term vs (@{term "real :: int \<Rightarrow> real"} $ (@{term "ceiling :: real \<Rightarrow> int"} $ t')) =
       @{code Neg} (@{code Floor} (@{code Neg} (num_of_term vs t')))
-  | num_of_term vs (@{term "number_of :: int \<Rightarrow> real"} $ t') =
-      @{code C} (HOLogic.dest_numeral t')
+  | num_of_term vs (@{term "numeral :: _ \<Rightarrow> real"} $ t') =
+      @{code C} (HOLogic.dest_num t')
+  | num_of_term vs (@{term "neg_numeral :: _ \<Rightarrow> real"} $ t') =
+      @{code C} (~ (HOLogic.dest_num t'))
   | num_of_term vs t = error ("num_of_term: unknown term " ^ Syntax.string_of_term @{context} t);
 
 fun fm_of_term vs @{term True} = @{code T}
@@ -5554,8 +5558,10 @@
       @{code Le} (@{code Sub} (num_of_term vs t1, num_of_term vs t2))
   | fm_of_term vs (@{term "op = :: real \<Rightarrow> real \<Rightarrow> bool"} $ t1 $ t2) =
       @{code Eq} (@{code Sub} (num_of_term vs t1, num_of_term vs t2)) 
-  | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "number_of :: int \<Rightarrow> int"} $ t1)) $ t2) =
-      @{code Dvd} (HOLogic.dest_numeral t1, num_of_term vs t2)
+  | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "numeral :: _ \<Rightarrow> int"} $ t1)) $ t2) =
+      @{code Dvd} (HOLogic.dest_num t1, num_of_term vs t2)
+  | fm_of_term vs (@{term "op rdvd"} $ (@{term "real :: int \<Rightarrow> real"} $ (@{term "neg_numeral :: _ \<Rightarrow> int"} $ t1)) $ t2) =
+      @{code Dvd} (~ (HOLogic.dest_num t1), num_of_term vs t2)
   | fm_of_term vs (@{term "op = :: bool \<Rightarrow> bool \<Rightarrow> bool"} $ t1 $ t2) =
       @{code Iff} (fm_of_term vs t1, fm_of_term vs t2)
   | fm_of_term vs (@{term HOL.conj} $ t1 $ t2) =
--- a/src/HOL/Decision_Procs/Parametric_Ferrante_Rackoff.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Decision_Procs/Parametric_Ferrante_Rackoff.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -25,7 +25,7 @@
 | "tmsize (CNP n c a) = 3 + polysize c + tmsize a "
 
   (* Semantics of terms tm *)
-primrec Itm :: "'a::{field_char_0, field_inverse_zero, number_ring} list \<Rightarrow> 'a list \<Rightarrow> tm \<Rightarrow> 'a" where
+primrec Itm :: "'a::{field_char_0, field_inverse_zero} list \<Rightarrow> 'a list \<Rightarrow> tm \<Rightarrow> 'a" where
   "Itm vs bs (CP c) = (Ipoly vs c)"
 | "Itm vs bs (Bound n) = bs!n"
 | "Itm vs bs (Neg a) = -(Itm vs bs a)"
@@ -430,7 +430,7 @@
 by (induct p rule: fmsize.induct) simp_all
 
   (* Semantics of formulae (fm) *)
-primrec Ifm ::"'a::{linordered_field_inverse_zero, number_ring} list \<Rightarrow> 'a list \<Rightarrow> fm \<Rightarrow> bool" where
+primrec Ifm ::"'a::{linordered_field_inverse_zero} list \<Rightarrow> 'a list \<Rightarrow> fm \<Rightarrow> bool" where
   "Ifm vs bs T = True"
 | "Ifm vs bs F = False"
 | "Ifm vs bs (Lt a) = (Itm vs bs a < 0)"
@@ -1937,7 +1937,7 @@
     
     also have "\<dots> \<longleftrightarrow> - (?a * ?s) + 2*?d*?r = 0" using d by simp 
     finally have ?thesis using c d 
-      by (simp add: r[of "- (Itm vs (x # bs) s / (2 * \<lparr>d\<rparr>\<^sub>p\<^bsup>vs\<^esup>))"] msubsteq_def Let_def evaldjf_ex del: one_add_one_is_two)
+      by (simp add: r[of "- (Itm vs (x # bs) s / (2 * \<lparr>d\<rparr>\<^sub>p\<^bsup>vs\<^esup>))"] msubsteq_def Let_def evaldjf_ex)
   }
   moreover
   {assume c: "?c \<noteq> 0" and d: "?d=0"
@@ -1950,7 +1950,7 @@
       by (simp add: field_simps right_distrib[of "2*?c"] del: right_distrib)
     also have "\<dots> \<longleftrightarrow> - (?a * ?t) + 2*?c*?r = 0" using c by simp 
     finally have ?thesis using c d 
-      by (simp add: r[of "- (?t/ (2*?c))"] msubsteq_def Let_def evaldjf_ex del: one_add_one_is_two)
+      by (simp add: r[of "- (?t/ (2*?c))"] msubsteq_def Let_def evaldjf_ex)
   }
   moreover
   {assume c: "?c \<noteq> 0" and d: "?d\<noteq>0" hence dc: "?c * ?d *2 \<noteq> 0" by simp
@@ -2019,7 +2019,7 @@
     
     also have "\<dots> \<longleftrightarrow> - (?a * ?s) + 2*?d*?r \<noteq> 0" using d by simp 
     finally have ?thesis using c d 
-      by (simp add: r[of "- (Itm vs (x # bs) s / (2 * \<lparr>d\<rparr>\<^sub>p\<^bsup>vs\<^esup>))"] msubstneq_def Let_def evaldjf_ex del: one_add_one_is_two)
+      by (simp add: r[of "- (Itm vs (x # bs) s / (2 * \<lparr>d\<rparr>\<^sub>p\<^bsup>vs\<^esup>))"] msubstneq_def Let_def evaldjf_ex)
   }
   moreover
   {assume c: "?c \<noteq> 0" and d: "?d=0"
@@ -2032,7 +2032,7 @@
       by (simp add: field_simps right_distrib[of "2*?c"] del: right_distrib)
     also have "\<dots> \<longleftrightarrow> - (?a * ?t) + 2*?c*?r \<noteq> 0" using c by simp 
     finally have ?thesis using c d 
-      by (simp add: r[of "- (?t/ (2*?c))"] msubstneq_def Let_def evaldjf_ex del: one_add_one_is_two)
+      by (simp add: r[of "- (?t/ (2*?c))"] msubstneq_def Let_def evaldjf_ex)
   }
   moreover
   {assume c: "?c \<noteq> 0" and d: "?d\<noteq>0" hence dc: "?c * ?d *2 \<noteq> 0" by simp
@@ -2616,10 +2616,10 @@
 using lp tnb
 by (simp add: msubst2_def msubstneg_nb msubstpos_nb conj_nb disj_nb lt_nb simpfm_bound0)
 
-lemma mult_minus2_left: "-2 * (x::'a::number_ring) = - (2 * x)"
+lemma mult_minus2_left: "-2 * (x::'a::comm_ring_1) = - (2 * x)"
   by simp
 
-lemma mult_minus2_right: "(x::'a::number_ring) * -2 = - (x * 2)"
+lemma mult_minus2_right: "(x::'a::comm_ring_1) * -2 = - (x * 2)"
   by simp
 
 lemma islin_qf: "islin p \<Longrightarrow> qfree p"
@@ -3005,11 +3005,11 @@
 *} "parametric QE for linear Arithmetic over fields, Version 2"
 
 
-lemma "\<exists>(x::'a::{linordered_field_inverse_zero, number_ring}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
-  apply (frpar type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "y::'a::{linordered_field_inverse_zero, number_ring}")
+lemma "\<exists>(x::'a::{linordered_field_inverse_zero}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
+  apply (frpar type: "'a::{linordered_field_inverse_zero}" pars: "y::'a::{linordered_field_inverse_zero}")
   apply (simp add: field_simps)
   apply (rule spec[where x=y])
-  apply (frpar type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "z::'a::{linordered_field_inverse_zero, number_ring}")
+  apply (frpar type: "'a::{linordered_field_inverse_zero}" pars: "z::'a::{linordered_field_inverse_zero}")
   by simp
 
 text{* Collins/Jones Problem *}
@@ -3030,11 +3030,11 @@
 oops
 *)
 
-lemma "\<exists>(x::'a::{linordered_field_inverse_zero, number_ring}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
-  apply (frpar2 type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "y::'a::{linordered_field_inverse_zero, number_ring}")
+lemma "\<exists>(x::'a::{linordered_field_inverse_zero}). y \<noteq> -1 \<longrightarrow> (y + 1)*x < 0"
+  apply (frpar2 type: "'a::{linordered_field_inverse_zero}" pars: "y::'a::{linordered_field_inverse_zero}")
   apply (simp add: field_simps)
   apply (rule spec[where x=y])
-  apply (frpar2 type: "'a::{linordered_field_inverse_zero, number_ring}" pars: "z::'a::{linordered_field_inverse_zero, number_ring}")
+  apply (frpar2 type: "'a::{linordered_field_inverse_zero}" pars: "z::'a::{linordered_field_inverse_zero}")
   by simp
 
 text{* Collins/Jones Problem *}
--- a/src/HOL/Decision_Procs/cooper_tac.ML	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Decision_Procs/cooper_tac.ML	Sun Mar 25 20:15:39 2012 +0200
@@ -18,15 +18,12 @@
 val cooper_ss = @{simpset};
 
 val nT = HOLogic.natT;
-val binarith = @{thms normalize_bin_simps};
-val comp_arith = binarith @ @{thms simp_thms};
+val comp_arith = @{thms simp_thms}
 
 val zdvd_int = @{thm zdvd_int};
 val zdiff_int_split = @{thm zdiff_int_split};
 val all_nat = @{thm all_nat};
 val ex_nat = @{thm ex_nat};
-val number_of1 = @{thm number_of1};
-val number_of2 = @{thm number_of2};
 val split_zdiv = @{thm split_zdiv};
 val split_zmod = @{thm split_zmod};
 val mod_div_equality' = @{thm mod_div_equality'};
@@ -90,14 +87,13 @@
           [split_zdiv, split_zmod, split_div', @{thm "split_min"}, @{thm "split_max"}]
     (* Simp rules for changing (n::int) to int n *)
     val simpset1 = HOL_basic_ss
-      addsimps [@{thm nat_number_of_def}, zdvd_int] @ map (fn r => r RS sym)
-        [@{thm int_int_eq}, @{thm zle_int}, @{thm zless_int}, @{thm zadd_int}, @{thm zmult_int}]
+      addsimps [zdvd_int] @ map (fn r => r RS sym)
+        [@{thm int_numeral}, @{thm int_int_eq}, @{thm zle_int}, @{thm zless_int}, @{thm zadd_int}, @{thm zmult_int}]
       |> Splitter.add_split zdiff_int_split
     (*simp rules for elimination of int n*)
 
     val simpset2 = HOL_basic_ss
-      addsimps [@{thm nat_0_le}, @{thm all_nat}, @{thm ex_nat},
-        @{thm number_of1}, @{thm number_of2}, @{thm int_0}, @{thm int_1}]
+      addsimps [@{thm nat_0_le}, @{thm all_nat}, @{thm ex_nat}, @{thm zero_le_numeral}, @{thm order_refl}(* FIXME: necessary? *), @{thm int_0}, @{thm int_1}]
       |> fold Simplifier.add_cong [@{thm conj_le_cong}, @{thm imp_le_cong}]
     (* simp rules for elimination of abs *)
     val simpset3 = HOL_basic_ss |> Splitter.add_split @{thm abs_split}
--- a/src/HOL/Decision_Procs/ex/Dense_Linear_Order_Ex.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Decision_Procs/ex/Dense_Linear_Order_Ex.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -7,147 +7,147 @@
 begin
 
 lemma
-  "\<exists>(y::'a::{linordered_field_inverse_zero, number_ring}) <2. x + 3* y < 0 \<and> x - y >0"
+  "\<exists>(y::'a::{linordered_field_inverse_zero}) <2. x + 3* y < 0 \<and> x - y >0"
   by ferrack
 
-lemma "~ (ALL x (y::'a::{linordered_field_inverse_zero, number_ring}). x < y --> 10*x < 11*y)"
+lemma "~ (ALL x (y::'a::{linordered_field_inverse_zero}). x < y --> 10*x < 11*y)"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. x < y --> (10*(x + 5*y + -1) < 60*y)"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. x < y --> (10*(x + 5*y + -1) < 60*y)"
   by ferrack
 
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. x ~= y --> x < y"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y. x ~= y --> x < y"
   by ferrack
 
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (x ~= y & 10*x ~= 9*y & 10*x < y) --> x < y"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (x ~= y & 10*x ~= 9*y & 10*x < y) --> x < y"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. (x ~= y & 5*x <= y) --> 500*x <= 100*y"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (x ~= y & 5*x <= y) --> 500*x <= 100*y"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). (EX (y::'a::{linordered_field_inverse_zero, number_ring}). 4*x + 3*y <= 0 & 4*x + 3*y >= -1)"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX (y::'a::{linordered_field_inverse_zero}). 4*x + 3*y <= 0 & 4*x + 3*y >= -1)"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) < 0. (EX (y::'a::{linordered_field_inverse_zero, number_ring}) > 0. 7*x + y > 0 & x - y <= 9)"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) < 0. (EX (y::'a::{linordered_field_inverse_zero}) > 0. 7*x + y > 0 & x - y <= 9)"
   by ferrack
 
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}). (0 < x & x < 1) --> (ALL y > 1. x + y ~= 1)"
+lemma "EX (x::'a::{linordered_field_inverse_zero}). (0 < x & x < 1) --> (ALL y > 1. x + y ~= 1)"
   by ferrack
 
-lemma "EX x. (ALL (y::'a::{linordered_field_inverse_zero, number_ring}). y < 2 -->  2*(y - x) \<le> 0 )"
+lemma "EX x. (ALL (y::'a::{linordered_field_inverse_zero}). y < 2 -->  2*(y - x) \<le> 0 )"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). x < 10 | x > 20 | (EX y. y>= 0 & y <= 10 & x+y = 20)"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}). x < 10 | x > 20 | (EX y. y>= 0 & y <= 10 & x+y = 20)"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y z. x + y < z --> y >= z --> x < 0"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y z. x + y < z --> y >= z --> x < 0"
   by ferrack
 
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y z. x + 7*y < 5* z & 5*y >= 7*z & x < 0"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y z. x + 7*y < 5* z & 5*y >= 7*z & x < 0"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y z. abs (x + y) <= z --> (abs z = z)"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y z. abs (x + y) <= z --> (abs z = z)"
   by ferrack
 
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y z. x + 7*y - 5* z < 0 & 5*y + 7*z + 3*x < 0"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y z. x + 7*y - 5* z < 0 & 5*y + 7*z + 3*x < 0"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y z. (abs (5*x+3*y+z) <= 5*x+3*y+z & abs (5*x+3*y+z) >= - (5*x+3*y+z)) | (abs (5*x+3*y+z) >= 5*x+3*y+z & abs (5*x+3*y+z) <= - (5*x+3*y+z))"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y z. (abs (5*x+3*y+z) <= 5*x+3*y+z & abs (5*x+3*y+z) >= - (5*x+3*y+z)) | (abs (5*x+3*y+z) >= 5*x+3*y+z & abs (5*x+3*y+z) <= - (5*x+3*y+z))"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. x < y --> (EX z>0. x+z = y)"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. x < y --> (EX z>0. x+z = y)"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. x < y --> (EX z>0. x+z = y)"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. x < y --> (EX z>0. x+z = y)"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. (EX z>0. abs (x - y) <= z )"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (EX z>0. abs (x - y) <= z )"
   by ferrack
 
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
   by ferrack
 
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (ALL z>=0. abs (3*x+7*y) <= 2*z + 1)"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (ALL z>=0. abs (3*x+7*y) <= 2*z + 1)"
   by ferrack
 
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y. (ALL z<0. (z < x --> z <= y) & (z > y --> z >= x))"
   by ferrack
 
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring})>0. (ALL y. (EX z. 13* abs z \<noteq> abs (12*y - x) & 5*x - 3*(abs y) <= 7*z))"
+lemma "EX (x::'a::{linordered_field_inverse_zero})>0. (ALL y. (EX z. 13* abs z \<noteq> abs (12*y - x) & 5*x - 3*(abs y) <= 7*z))"
   by ferrack
 
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}). abs (4*x + 17) < 4 & (ALL y . abs (x*34 - 34*y - 9) \<noteq> 0 \<longrightarrow> (EX z. 5*x - 3*abs y <= 7*z))"
+lemma "EX (x::'a::{linordered_field_inverse_zero}). abs (4*x + 17) < 4 & (ALL y . abs (x*34 - 34*y - 9) \<noteq> 0 \<longrightarrow> (EX z. 5*x - 3*abs y <= 7*z))"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). (EX y > abs (23*x - 9). (ALL z > abs (3*y - 19* abs x). x+z > 2*y))"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX y > abs (23*x - 9). (ALL z > abs (3*y - 19* abs x). x+z > 2*y))"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). (EX y< abs (3*x - 1). (ALL z >= (3*abs x - 1). abs (12*x - 13*y + 19*z) > abs (23*x) ))"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX y< abs (3*x - 1). (ALL z >= (3*abs x - 1). abs (12*x - 13*y + 19*z) > abs (23*x) ))"
   by ferrack
 
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}). abs x < 100 & (ALL y > x. (EX z<2*y - x. 5*x - 3*y <= 7*z))"
+lemma "EX (x::'a::{linordered_field_inverse_zero}). abs x < 100 & (ALL y > x. (EX z<2*y - x. 5*x - 3*y <= 7*z))"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y z w. 7*x<3*y --> 5*y < 7*z --> z < 2*w --> 7*(2*w-x) > 2*y"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y z w. 7*x<3*y --> 5*y < 7*z --> z < 2*w --> 7*(2*w-x) > 2*y"
   by ferrack
 
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y z w. 5*x + 3*z - 17*w + abs (y - 8*x + z) <= 89"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y z w. 5*x + 3*z - 17*w + abs (y - 8*x + z) <= 89"
   by ferrack
 
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y z w. 5*x + 3*z - 17*w + 7* (y - 8*x + z) <= max y (7*z - x + w)"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y z w. 5*x + 3*z - 17*w + 7* (y - 8*x + z) <= max y (7*z - x + w)"
   by ferrack
 
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w)"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w)"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y z. (EX w >= (x+y+z). w <= abs x + abs y + abs z)"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y z. (EX w >= (x+y+z). w <= abs x + abs y + abs z)"
   by ferrack
 
-lemma "~(ALL (x::'a::{linordered_field_inverse_zero, number_ring}). (EX y z w. 3* x + z*4 = 3*y & x + y < z & x> w & 3*x < w + y))"
+lemma "~(ALL (x::'a::{linordered_field_inverse_zero}). (EX y z w. 3* x + z*4 = 3*y & x + y < z & x> w & 3*x < w + y))"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. (EX z w. abs (x-y) = (z-w) & z*1234 < 233*x & w ~= y)"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (EX z w. abs (x-y) = (z-w) & z*1234 < 233*x & w ~= y)"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). (EX y z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w))"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX y z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w))"
   by ferrack
 
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y z. (ALL w >= abs (x+y+z). w >= abs x + abs y + abs z)"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y z. (ALL w >= abs (x+y+z). w >= abs x + abs y + abs z)"
   by ferrack
 
-lemma "EX z. (ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. (EX w >= (x+y+z). w <= abs x + abs y + abs z))"
+lemma "EX z. (ALL (x::'a::{linordered_field_inverse_zero}) y. (EX w >= (x+y+z). w <= abs x + abs y + abs z))"
   by ferrack
 
-lemma "EX z. (ALL (x::'a::{linordered_field_inverse_zero, number_ring}) < abs z. (EX y w. x< y & x < z & x> w & 3*x < w + y))"
+lemma "EX z. (ALL (x::'a::{linordered_field_inverse_zero}) < abs z. (EX y w. x< y & x < z & x> w & 3*x < w + y))"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}) y. (EX z. (ALL w. abs (x-y) = abs (z-w) --> z < x & w ~= y))"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}) y. (EX z. (ALL w. abs (x-y) = abs (z-w) --> z < x & w ~= y))"
   by ferrack
 
-lemma "EX y. (ALL (x::'a::{linordered_field_inverse_zero, number_ring}). (EX z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w)))"
+lemma "EX y. (ALL (x::'a::{linordered_field_inverse_zero}). (EX z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w)))"
   by ferrack
 
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) z. (ALL w >= 13*x - 4*z. (EX y. w >= abs x + abs y + z))"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) z. (ALL w >= 13*x - 4*z. (EX y. w >= abs x + abs y + z))"
   by ferrack
 
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}). (ALL y < x. (EX z > (x+y).
+lemma "EX (x::'a::{linordered_field_inverse_zero}). (ALL y < x. (EX z > (x+y).
   (ALL w. 5*w + 10*x - z >= y --> w + 7*x + 3*z >= 2*y)))"
   by ferrack
 
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}). (ALL y. (EX z > y.
+lemma "EX (x::'a::{linordered_field_inverse_zero}). (ALL y. (EX z > y.
   (ALL w . w < 13 --> w + 10*x - z >= y --> 5*w + 7*x + 13*z >= 2*y)))"
   by ferrack
 
-lemma "EX (x::'a::{linordered_field_inverse_zero, number_ring}) y z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w)"
+lemma "EX (x::'a::{linordered_field_inverse_zero}) y z w. min (5*x + 3*z) (17*w) + 5* abs (y - 8*x + z) <= max y (7*z - x + w)"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). (EX y. (ALL z>19. y <= x + z & (EX w. abs (y - x) < w)))"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX y. (ALL z>19. y <= x + z & (EX w. abs (y - x) < w)))"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). (EX y. (ALL z>19. y <= x + z & (EX w. abs (x + z) < w - y)))"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX y. (ALL z>19. y <= x + z & (EX w. abs (x + z) < w - y)))"
   by ferrack
 
-lemma "ALL (x::'a::{linordered_field_inverse_zero, number_ring}). (EX y. abs y ~= abs x & (ALL z> max x y. (EX w. w ~= y & w ~= z & 3*w - z >= x + y)))"
+lemma "ALL (x::'a::{linordered_field_inverse_zero}). (EX y. abs y ~= abs x & (ALL z> max x y. (EX w. w ~= y & w ~= z & 3*w - z >= x + y)))"
   by ferrack
 
 end
--- a/src/HOL/Decision_Procs/ferrack_tac.ML	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Decision_Procs/ferrack_tac.ML	Sun Mar 25 20:15:39 2012 +0200
@@ -20,17 +20,13 @@
              in @{simpset} delsimps ths addsimps (map (fn th => th RS sym) ths)
              end;
 
-val binarith =
-  @{thms normalize_bin_simps} @ @{thms pred_bin_simps} @ @{thms succ_bin_simps} @
-  @{thms add_bin_simps} @ @{thms minus_bin_simps} @  @{thms mult_bin_simps};
-val comp_arith = binarith @ @{thms simp_thms};
+val binarith = @{thms arith_simps}
+val comp_arith = binarith @ @{thms simp_thms}
 
 val zdvd_int = @{thm zdvd_int};
 val zdiff_int_split = @{thm zdiff_int_split};
 val all_nat = @{thm all_nat};
 val ex_nat = @{thm ex_nat};
-val number_of1 = @{thm number_of1};
-val number_of2 = @{thm number_of2};
 val split_zdiv = @{thm split_zdiv};
 val split_zmod = @{thm split_zmod};
 val mod_div_equality' = @{thm mod_div_equality'};
--- a/src/HOL/Decision_Procs/mir_tac.ML	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Decision_Procs/mir_tac.ML	Sun Mar 25 20:15:39 2012 +0200
@@ -21,16 +21,15 @@
 end;
 
 val nT = HOLogic.natT;
-  val nat_arith = [@{thm "add_nat_number_of"}, @{thm "diff_nat_number_of"},
-                       @{thm "mult_nat_number_of"}, @{thm "eq_nat_number_of"}, @{thm "less_nat_number_of"}];
+  val nat_arith = [@{thm diff_nat_numeral}];
 
   val comp_arith = [@{thm "Let_def"}, @{thm "if_False"}, @{thm "if_True"}, @{thm "add_0"},
-                 @{thm "add_Suc"}, @{thm "add_number_of_left"}, @{thm "mult_number_of_left"},
+                 @{thm "add_Suc"}, @{thm add_numeral_left}, @{thm mult_numeral_left(1)},
                  @{thm "Suc_eq_plus1"}] @
-                 (map (fn th => th RS sym) [@{thm "numeral_1_eq_1"}, @{thm "numeral_0_eq_0"}])
+                 (map (fn th => th RS sym) [@{thm "numeral_1_eq_1"}])
                  @ @{thms arith_simps} @ nat_arith @ @{thms rel_simps} 
   val ths = [@{thm "mult_numeral_1"}, @{thm "mult_numeral_1_right"}, 
-             @{thm "real_of_nat_number_of"},
+             @{thm real_of_nat_numeral},
              @{thm "real_of_nat_Suc"}, @{thm "real_of_nat_one"}, @{thm "real_of_one"},
              @{thm "real_of_int_zero"}, @{thm "real_of_nat_zero"},
              @{thm "divide_zero"}, 
@@ -44,8 +43,6 @@
 val zdiff_int_split = @{thm "zdiff_int_split"};
 val all_nat = @{thm "all_nat"};
 val ex_nat = @{thm "ex_nat"};
-val number_of1 = @{thm "number_of1"};
-val number_of2 = @{thm "number_of2"};
 val split_zdiv = @{thm "split_zdiv"};
 val split_zmod = @{thm "split_zmod"};
 val mod_div_equality' = @{thm "mod_div_equality'"};
@@ -113,15 +110,15 @@
             @{thm "split_min"}, @{thm "split_max"}]
     (* Simp rules for changing (n::int) to int n *)
     val simpset1 = HOL_basic_ss
-      addsimps [@{thm "nat_number_of_def"}, @{thm "zdvd_int"}] @ map (fn r => r RS sym)
+      addsimps [@{thm "zdvd_int"}] @ map (fn r => r RS sym)
         [@{thm "int_int_eq"}, @{thm "zle_int"}, @{thm "zless_int"}, @{thm "zadd_int"}, 
-         @{thm "zmult_int"}]
+         @{thm nat_numeral}, @{thm "zmult_int"}]
       |> Splitter.add_split @{thm "zdiff_int_split"}
     (*simp rules for elimination of int n*)
 
     val simpset2 = HOL_basic_ss
-      addsimps [@{thm "nat_0_le"}, @{thm "all_nat"}, @{thm "ex_nat"}, @{thm "number_of1"}, 
-                @{thm "number_of2"}, @{thm "int_0"}, @{thm "int_1"}]
+      addsimps [@{thm "nat_0_le"}, @{thm "all_nat"}, @{thm "ex_nat"}, @{thm zero_le_numeral}, 
+                @{thm "int_0"}, @{thm "int_1"}]
       |> fold Simplifier.add_cong [@{thm "conj_le_cong"}, @{thm "imp_le_cong"}]
     (* simp rules for elimination of abs *)
     val ct = cterm_of thy (HOLogic.mk_Trueprop t)
--- a/src/HOL/Deriv.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Deriv.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -186,7 +186,6 @@
 apply (erule DERIV_mult')
 apply (erule (1) DERIV_inverse')
 apply (simp add: ring_distribs nonzero_inverse_mult_distrib)
-apply (simp add: mult_ac)
 done
 
 lemma DERIV_power_Suc:
--- a/src/HOL/Divides.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Divides.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -1138,8 +1138,8 @@
 lemma Suc_mod_eq_add3_mod: "(Suc (Suc (Suc m))) mod n = (3+m) mod n"
 by (simp add: Suc3_eq_add_3)
 
-lemmas Suc_div_eq_add3_div_number_of [simp] = Suc_div_eq_add3_div [of _ "number_of v"] for v
-lemmas Suc_mod_eq_add3_mod_number_of [simp] = Suc_mod_eq_add3_mod [of _ "number_of v"] for v
+lemmas Suc_div_eq_add3_div_numeral [simp] = Suc_div_eq_add3_div [of _ "numeral v"] for v
+lemmas Suc_mod_eq_add3_mod_numeral [simp] = Suc_mod_eq_add3_mod [of _ "numeral v"] for v
 
 
 lemma Suc_times_mod_eq: "1<k ==> Suc (k * m) mod k = 1" 
@@ -1147,7 +1147,7 @@
 apply (simp_all add: mod_Suc)
 done
 
-declare Suc_times_mod_eq [of "number_of w", simp] for w
+declare Suc_times_mod_eq [of "numeral w", simp] for w
 
 lemma [simp]: "n div k \<le> (Suc n) div k"
 by (simp add: div_le_mono) 
@@ -1177,17 +1177,22 @@
 apply (subst mod_Suc [of "m mod n"], simp) 
 done
 
+lemma mod_2_not_eq_zero_eq_one_nat:
+  fixes n :: nat
+  shows "n mod 2 \<noteq> 0 \<longleftrightarrow> n mod 2 = 1"
+  by simp
+
 
 subsection {* Division on @{typ int} *}
 
 definition divmod_int_rel :: "int \<Rightarrow> int \<Rightarrow> int \<times> int \<Rightarrow> bool" where
     --{*definition of quotient and remainder*}
-    [code]: "divmod_int_rel a b = (\<lambda>(q, r). a = b * q + r \<and>
+    "divmod_int_rel a b = (\<lambda>(q, r). a = b * q + r \<and>
                (if 0 < b then 0 \<le> r \<and> r < b else b < r \<and> r \<le> 0))"
 
 definition adjust :: "int \<Rightarrow> int \<times> int \<Rightarrow> int \<times> int" where
     --{*for the division algorithm*}
-    [code]: "adjust b = (\<lambda>(q, r). if 0 \<le> r - b then (2 * q + 1, r - b)
+    "adjust b = (\<lambda>(q, r). if 0 \<le> r - b then (2 * q + 1, r - b)
                          else (2 * q, r))"
 
 text{*algorithm for the case @{text "a\<ge>0, b>0"}*}
@@ -1318,11 +1323,11 @@
 text{*And positive divisors*}
 
 lemma adjust_eq [simp]:
-     "adjust b (q,r) = 
-      (let diff = r-b in  
-        if 0 \<le> diff then (2*q + 1, diff)   
+     "adjust b (q, r) = 
+      (let diff = r - b in  
+        if 0 \<le> diff then (2 * q + 1, diff)   
                      else (2*q, r))"
-by (simp add: Let_def adjust_def)
+  by (simp add: Let_def adjust_def)
 
 declare posDivAlg.simps [simp del]
 
@@ -1420,6 +1425,9 @@
 
 text {* Tool setup *}
 
+(* FIXME: Theorem list add_0s doesn't exist, because Numeral0 has gone. *)
+lemmas add_0s = add_0_left add_0_right
+
 ML {*
 structure Cancel_Div_Mod_Int = Cancel_Div_Mod
 (
@@ -1674,16 +1682,6 @@
   by (rule divmod_int_rel_mod [of a b q r],
     simp add: divmod_int_rel_def)
 
-lemmas arithmetic_simps =
-  arith_simps
-  add_special
-  add_0_left
-  add_0_right
-  mult_zero_left
-  mult_zero_right
-  mult_1_left
-  mult_1_right
-
 (* simprocs adapted from HOL/ex/Binary.thy *)
 ML {*
 local
@@ -1694,7 +1692,7 @@
   val less = @{term "op < :: int \<Rightarrow> int \<Rightarrow> bool"}
   val le = @{term "op \<le> :: int \<Rightarrow> int \<Rightarrow> bool"}
   val simps = @{thms arith_simps} @ @{thms rel_simps} @
-    map (fn th => th RS sym) [@{thm numeral_0_eq_0}, @{thm numeral_1_eq_1}]
+    map (fn th => th RS sym) [@{thm numeral_1_eq_1}]
   fun prove ctxt goal = Goal.prove ctxt [] [] (HOLogic.mk_Trueprop goal)
     (K (ALLGOALS (full_simp_tac (HOL_basic_ss addsimps simps))));
   fun binary_proc proc ss ct =
@@ -1717,14 +1715,25 @@
 end
 *}
 
-simproc_setup binary_int_div ("number_of m div number_of n :: int") =
+simproc_setup binary_int_div
+  ("numeral m div numeral n :: int" |
+   "numeral m div neg_numeral n :: int" |
+   "neg_numeral m div numeral n :: int" |
+   "neg_numeral m div neg_numeral n :: int") =
   {* K (divmod_proc @{thm int_div_pos_eq} @{thm int_div_neg_eq}) *}
 
-simproc_setup binary_int_mod ("number_of m mod number_of n :: int") =
+simproc_setup binary_int_mod
+  ("numeral m mod numeral n :: int" |
+   "numeral m mod neg_numeral n :: int" |
+   "neg_numeral m mod numeral n :: int" |
+   "neg_numeral m mod neg_numeral n :: int") =
   {* K (divmod_proc @{thm int_mod_pos_eq} @{thm int_mod_neg_eq}) *}
 
-lemmas posDivAlg_eqn_number_of [simp] = posDivAlg_eqn [of "number_of v" "number_of w"] for v w
-lemmas negDivAlg_eqn_number_of [simp] = negDivAlg_eqn [of "number_of v" "number_of w"] for v w
+lemmas posDivAlg_eqn_numeral [simp] =
+    posDivAlg_eqn [of "numeral v" "numeral w", OF zero_less_numeral] for v w
+
+lemmas negDivAlg_eqn_numeral [simp] =
+    negDivAlg_eqn [of "numeral v" "neg_numeral w", OF zero_less_numeral] for v w
 
 
 text{*Special-case simplification *}
@@ -1741,12 +1750,25 @@
 (** The last remaining special cases for constant arithmetic:
     1 div z and 1 mod z **)
 
-lemmas div_pos_pos_1_number_of [simp] = div_pos_pos [OF zero_less_one, of "number_of w"] for w
-lemmas div_pos_neg_1_number_of [simp] = div_pos_neg [OF zero_less_one, of "number_of w"] for w
-lemmas mod_pos_pos_1_number_of [simp] = mod_pos_pos [OF zero_less_one, of "number_of w"] for w
-lemmas mod_pos_neg_1_number_of [simp] = mod_pos_neg [OF zero_less_one, of "number_of w"] for w
-lemmas posDivAlg_eqn_1_number_of [simp] = posDivAlg_eqn [of concl: 1 "number_of w"] for w
-lemmas negDivAlg_eqn_1_number_of [simp] = negDivAlg_eqn [of concl: 1 "number_of w"] for w
+lemmas div_pos_pos_1_numeral [simp] =
+  div_pos_pos [OF zero_less_one, of "numeral w", OF zero_le_numeral] for w
+
+lemmas div_pos_neg_1_numeral [simp] =
+  div_pos_neg [OF zero_less_one, of "neg_numeral w",
+  OF neg_numeral_less_zero] for w
+
+lemmas mod_pos_pos_1_numeral [simp] =
+  mod_pos_pos [OF zero_less_one, of "numeral w", OF zero_le_numeral] for w
+
+lemmas mod_pos_neg_1_numeral [simp] =
+  mod_pos_neg [OF zero_less_one, of "neg_numeral w",
+  OF neg_numeral_less_zero] for w
+
+lemmas posDivAlg_eqn_1_numeral [simp] =
+    posDivAlg_eqn [of concl: 1 "numeral w", OF zero_less_numeral] for w
+
+lemmas negDivAlg_eqn_1_numeral [simp] =
+    negDivAlg_eqn [of concl: 1 "numeral w", OF zero_less_numeral] for w
 
 
 subsubsection {* Monotonicity in the First Argument (Dividend) *}
@@ -1928,6 +1950,11 @@
 (* REVISIT: should this be generalized to all semiring_div types? *)
 lemmas zmod_eq_0D [dest!] = zmod_eq_0_iff [THEN iffD1]
 
+lemma zmod_zdiv_equality':
+  "(m\<Colon>int) mod n = m - (m div n) * n"
+  by (rule_tac P="%x. m mod n = x - (m div n) * n" in subst [OF mod_div_equality [of _ n]])
+    arith
+
 
 subsubsection {* Proving  @{term "a div (b*c) = (a div b) div c"} *}
 
@@ -1989,6 +2016,26 @@
 apply (force simp add: divmod_int_rel_div_mod [THEN zmult2_lemma, THEN divmod_int_rel_mod])
 done
 
+lemma div_pos_geq:
+  fixes k l :: int
+  assumes "0 < l" and "l \<le> k"
+  shows "k div l = (k - l) div l + 1"
+proof -
+  have "k = (k - l) + l" by simp
+  then obtain j where k: "k = j + l" ..
+  with assms show ?thesis by simp
+qed
+
+lemma mod_pos_geq:
+  fixes k l :: int
+  assumes "0 < l" and "l \<le> k"
+  shows "k mod l = (k - l) mod l"
+proof -
+  have "k = (k - l) + l" by simp
+  then obtain j where k: "k = j + l" ..
+  with assms show ?thesis by simp
+qed
+
 
 subsubsection {* Splitting Rules for div and mod *}
 
@@ -2046,9 +2093,9 @@
 
 text {* Enable (lin)arith to deal with @{const div} and @{const mod}
   when these are applied to some constant that is of the form
-  @{term "number_of k"}: *}
-declare split_zdiv [of _ _ "number_of k", arith_split] for k
-declare split_zmod [of _ _ "number_of k", arith_split] for k
+  @{term "numeral k"}: *}
+declare split_zdiv [of _ _ "numeral k", arith_split] for k
+declare split_zmod [of _ _ "numeral k", arith_split] for k
 
 
 subsubsection {* Speeding up the Division Algorithm with Shifting *}
@@ -2090,19 +2137,19 @@
       minus_add_distrib [symmetric] mult_minus_right)
 qed
 
-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)"
-by (simp only: number_of_eq numeral_simps) (simp add: mult_2 [symmetric])
-
-lemma zdiv_number_of_Bit1 [simp]:
-     "number_of (Int.Bit1 v) div number_of (Int.Bit0 w) =  
-          (if (0::int) \<le> number_of w                    
-           then number_of v div (number_of w)     
-           else (number_of v + (1::int)) div (number_of w))"
-apply (simp only: number_of_eq numeral_simps UNIV_I split: split_if) 
-apply (simp add: pos_zdiv_mult_2 neg_zdiv_mult_2 add_ac mult_2 [symmetric])
-done
+(* FIXME: add rules for negative numerals *)
+lemma zdiv_numeral_Bit0 [simp]:
+  "numeral (Num.Bit0 v) div numeral (Num.Bit0 w) =
+    numeral v div (numeral w :: int)"
+  unfolding numeral.simps unfolding mult_2 [symmetric]
+  by (rule div_mult_mult1, simp)
+
+lemma zdiv_numeral_Bit1 [simp]:
+  "numeral (Num.Bit1 v) div numeral (Num.Bit0 w) =  
+    (numeral v div (numeral w :: int))"
+  unfolding numeral.simps
+  unfolding mult_2 [symmetric] add_commute [of _ 1]
+  by (rule pos_zdiv_mult_2, simp)
 
 
 subsubsection {* Computing mod by Shifting (proofs resemble those for div) *}
@@ -2138,24 +2185,19 @@
      (simp add: diff_minus add_ac)
 qed
 
-lemma zmod_number_of_Bit0 [simp]:
-     "number_of (Int.Bit0 v) mod number_of (Int.Bit0 w) =  
-      (2::int) * (number_of v mod number_of w)"
-apply (simp only: number_of_eq numeral_simps) 
-apply (simp add: mod_mult_mult1 pos_zmod_mult_2 
-                 neg_zmod_mult_2 add_ac mult_2 [symmetric])
-done
-
-lemma zmod_number_of_Bit1 [simp]:
-     "number_of (Int.Bit1 v) mod number_of (Int.Bit0 w) =  
-      (if (0::int) \<le> number_of w  
-                then 2 * (number_of v mod number_of w) + 1     
-                else 2 * ((number_of v + (1::int)) mod number_of w) - 1)"
-apply (simp only: number_of_eq numeral_simps) 
-apply (simp add: mod_mult_mult1 pos_zmod_mult_2 
-                 neg_zmod_mult_2 add_ac mult_2 [symmetric])
-done
-
+(* FIXME: add rules for negative numerals *)
+lemma zmod_numeral_Bit0 [simp]:
+  "numeral (Num.Bit0 v) mod numeral (Num.Bit0 w) =  
+    (2::int) * (numeral v mod numeral w)"
+  unfolding numeral_Bit0 [of v] numeral_Bit0 [of w]
+  unfolding mult_2 [symmetric] by (rule mod_mult_mult1)
+
+lemma zmod_numeral_Bit1 [simp]:
+  "numeral (Num.Bit1 v) mod numeral (Num.Bit0 w) =
+    2 * (numeral v mod numeral w) + (1::int)"
+  unfolding numeral_Bit1 [of v] numeral_Bit0 [of w]
+  unfolding mult_2 [symmetric] add_commute [of _ 1]
+  by (rule pos_zmod_mult_2, simp)
 
 lemma zdiv_eq_0_iff:
  "(i::int) div k = 0 \<longleftrightarrow> k=0 \<or> 0\<le>i \<and> i<k \<or> i\<le>0 \<and> k<i" (is "?L = ?R")
@@ -2233,8 +2275,11 @@
 
 subsubsection {* The Divides Relation *}
 
-lemmas zdvd_iff_zmod_eq_0_number_of [simp] =
-  dvd_eq_mod_eq_0 [of "number_of x" "number_of y"] for x y :: int
+lemmas zdvd_iff_zmod_eq_0_numeral [simp] =
+  dvd_eq_mod_eq_0 [of "numeral x::int" "numeral y::int"]
+  dvd_eq_mod_eq_0 [of "numeral x::int" "neg_numeral y::int"]
+  dvd_eq_mod_eq_0 [of "neg_numeral x::int" "numeral y::int"]
+  dvd_eq_mod_eq_0 [of "neg_numeral x::int" "neg_numeral y::int"] for x y
 
 lemma zdvd_zmod: "f dvd m ==> f dvd (n::int) ==> f dvd m mod n"
   by (rule dvd_mod) (* TODO: remove *)
@@ -2242,6 +2287,12 @@
 lemma zdvd_zmod_imp_zdvd: "k dvd m mod n ==> k dvd n ==> k dvd (m::int)"
   by (rule dvd_mod_imp_dvd) (* TODO: remove *)
 
+lemmas dvd_eq_mod_eq_0_numeral [simp] =
+  dvd_eq_mod_eq_0 [of "numeral x" "numeral y"] for x y
+
+
+subsubsection {* Further properties *}
+
 lemma zmult_div_cancel: "(n::int) * (m div n) = m - (m mod n)"
   using zmod_zdiv_equality[where a="m" and b="n"]
   by (simp add: algebra_simps)
@@ -2408,42 +2459,31 @@
   thus  ?lhs by simp
 qed
 
-lemma div_nat_number_of [simp]:
-     "(number_of v :: nat)  div  number_of v' =  
-          (if neg (number_of v :: int) then 0  
-           else nat (number_of v div number_of v'))"
-  unfolding nat_number_of_def number_of_is_id neg_def
+lemma div_nat_numeral [simp]:
+  "(numeral v :: nat) div numeral v' = nat (numeral v div numeral v')"
   by (simp add: nat_div_distrib)
 
-lemma one_div_nat_number_of [simp]:
-     "Suc 0 div number_of v' = nat (1 div number_of v')" 
-  by (simp del: semiring_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric] semiring_numeral_1_eq_1 [symmetric]) 
-
-lemma mod_nat_number_of [simp]:
-     "(number_of v :: nat)  mod  number_of v' =  
-        (if neg (number_of v :: int) then 0  
-         else if neg (number_of v' :: int) then number_of v  
-         else nat (number_of v mod number_of v'))"
-  unfolding nat_number_of_def number_of_is_id neg_def
+lemma one_div_nat_numeral [simp]:
+  "Suc 0 div numeral v' = nat (1 div numeral v')"
+  by (subst nat_div_distrib, simp_all)
+
+lemma mod_nat_numeral [simp]:
+  "(numeral v :: nat) mod numeral v' = nat (numeral v mod numeral v')"
   by (simp add: nat_mod_distrib)
 
-lemma one_mod_nat_number_of [simp]:
-     "Suc 0 mod number_of v' =  
-        (if neg (number_of v' :: int) then Suc 0
-         else nat (1 mod number_of v'))"
-by (simp del: semiring_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric] semiring_numeral_1_eq_1 [symmetric]) 
-
-lemmas dvd_eq_mod_eq_0_number_of [simp] =
-  dvd_eq_mod_eq_0 [of "number_of x" "number_of y"] for x y
-
-
-subsubsection {* Nitpick *}
-
-lemma zmod_zdiv_equality':
-"(m\<Colon>int) mod n = m - (m div n) * n"
-by (rule_tac P="%x. m mod n = x - (m div n) * n"
-    in subst [OF mod_div_equality [of _ n]])
-   arith
+lemma one_mod_nat_numeral [simp]:
+  "Suc 0 mod numeral v' = nat (1 mod numeral v')"
+  by (subst nat_mod_distrib) simp_all
+
+lemma mod_2_not_eq_zero_eq_one_int:
+  fixes k :: int
+  shows "k mod 2 \<noteq> 0 \<longleftrightarrow> k mod 2 = 1"
+  by auto
+
+
+subsubsection {* Tools setup *}
+
+text {* Nitpick *}
 
 lemmas [nitpick_unfold] = dvd_eq_mod_eq_0 mod_div_equality' zmod_zdiv_equality'
 
@@ -2461,7 +2501,7 @@
   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))))"
+       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
@@ -2481,45 +2521,6 @@
   then show ?thesis by (simp add: divmod_int_pdivmod)
 qed
 
-context ring_1
-begin
-
-lemma of_int_num [code]:
-  "of_int k = (if k = 0 then 0 else if k < 0 then
-     - of_int (- k) else let
-       (l, m) = divmod_int k 2;
-       l' = of_int l
-     in if m = 0 then l' + l' else l' + l' + 1)"
-proof -
-  have aux1: "k mod (2\<Colon>int) \<noteq> (0\<Colon>int) \<Longrightarrow> 
-    of_int k = of_int (k div 2 * 2 + 1)"
-  proof -
-    have "k mod 2 < 2" by (auto intro: pos_mod_bound)
-    moreover have "0 \<le> k mod 2" by (auto intro: pos_mod_sign)
-    moreover assume "k mod 2 \<noteq> 0"
-    ultimately have "k mod 2 = 1" by arith
-    moreover have "of_int k = of_int (k div 2 * 2 + k mod 2)" by simp
-    ultimately show ?thesis by auto
-  qed
-  have aux2: "\<And>x. of_int 2 * x = x + x"
-  proof -
-    fix x
-    have int2: "(2::int) = 1 + 1" by arith
-    show "of_int 2 * x = x + x"
-    unfolding int2 of_int_add left_distrib by simp
-  qed
-  have aux3: "\<And>x. x * of_int 2 = x + x"
-  proof -
-    fix x
-    have int2: "(2::int) = 1 + 1" by arith
-    show "x * of_int 2 = x + x" 
-    unfolding int2 of_int_add right_distrib by simp
-  qed
-  from aux1 show ?thesis by (auto simp add: divmod_int_mod_div Let_def aux2 aux3)
-qed
-
-end
-
 code_modulename SML
   Divides Arith
 
--- a/src/HOL/Imperative_HOL/ex/Imperative_Quicksort.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Imperative_HOL/ex/Imperative_Quicksort.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -6,7 +6,7 @@
 
 theory Imperative_Quicksort
 imports
-  Imperative_HOL
+  "~~/src/HOL/Imperative_HOL/Imperative_HOL"
   Subarray
   "~~/src/HOL/Library/Multiset"
   "~~/src/HOL/Library/Efficient_Nat"
@@ -593,8 +593,8 @@
 proof (induct a l r p arbitrary: h rule: part1.induct)
   case (1 a l r p)
   thus ?case unfolding part1.simps [of a l r]
-  apply (auto intro!: success_intros del: success_ifI simp add: not_le)
-  apply (auto intro!: effect_intros effect_swapI)
+  apply (auto intro!: success_intros simp add: not_le)
+  apply (auto intro!: effect_intros)
   done
 qed
 
--- a/src/HOL/Imperative_HOL/ex/Imperative_Reverse.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Imperative_HOL/ex/Imperative_Reverse.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -5,7 +5,7 @@
 header {* An imperative in-place reversal on arrays *}
 
 theory Imperative_Reverse
-imports Subarray Imperative_HOL
+imports Subarray "~~/src/HOL/Imperative_HOL/Imperative_HOL"
 begin
 
 fun swap :: "'a\<Colon>heap array \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> unit Heap" where
@@ -107,7 +107,7 @@
   shows "Array.get h' a = List.rev (Array.get h a)"
   using rev2_rev'[OF assms] rev_length[OF assms] assms
     by (cases "Array.length h a = 0", auto simp add: Array.length_def
-      subarray_def sublist'_all rev.simps[where j=0] elim!: effect_elims)
+      subarray_def rev.simps[where j=0] elim!: effect_elims)
   (drule sym[of "List.length (Array.get h a)"], simp)
 
 definition "example = (Array.make 10 id \<guillemotright>= (\<lambda>a. rev a 0 9))"
@@ -115,3 +115,4 @@
 export_code example checking SML SML_imp OCaml? OCaml_imp? Haskell? Scala? Scala_imp?
 
 end
+
--- a/src/HOL/Imperative_HOL/ex/SatChecker.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Imperative_HOL/ex/SatChecker.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -702,15 +702,7 @@
                 else raise(''No empty clause''))
   }"
 
-section {* Code generation setup *}
-
-code_type ProofStep
-  (SML "MinisatProofStep.ProofStep")
-
-code_const ProofDone and Root and Conflict and Delete and Xstep
-  (SML "MinisatProofStep.ProofDone" and "MinisatProofStep.Root ((_),/ (_))" and "MinisatProofStep.Conflict ((_),/ (_))" and "MinisatProofStep.Delete" and "MinisatProofStep.Xstep ((_),/ (_))")
-
-export_code checker tchecker lchecker in SML
+export_code checker tchecker lchecker checking SML
 
 end
 
--- a/src/HOL/Imperative_HOL/ex/Subarray.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Imperative_HOL/ex/Subarray.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -5,7 +5,7 @@
 header {* Theorems about sub arrays *}
 
 theory Subarray
-imports Array Sublist
+imports "~~/src/HOL/Imperative_HOL/Array" Sublist
 begin
 
 definition subarray :: "nat \<Rightarrow> nat \<Rightarrow> ('a::heap) array \<Rightarrow> heap \<Rightarrow> 'a list" where
--- a/src/HOL/Import/HOL_Light/HOLLightInt.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Import/HOL_Light/HOLLightInt.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -40,7 +40,7 @@
 
 lemma DEF_int_mul:
   "op * = (\<lambda>u ua. floor (real u * real ua))"
-  by (metis floor_number_of number_of_is_id number_of_real_def real_eq_of_int real_of_int_mult)
+  by (metis floor_real_of_int real_of_int_mult)
 
 lemma DEF_int_abs:
   "abs = (\<lambda>u. floor (abs (real u)))"
@@ -72,7 +72,7 @@
 
 lemma INT_IMAGE:
   "(\<exists>n. x = int n) \<or> (\<exists>n. x = - int n)"
-  by (metis number_of_eq number_of_is_id of_int_of_nat)
+  by (metis of_int_eq_id id_def of_int_of_nat)
 
 lemma DEF_int_pow:
   "op ^ = (\<lambda>u ua. floor (real u ^ ua))"
--- a/src/HOL/Int.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Int.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -6,10 +6,9 @@
 header {* The Integers as Equivalence Classes over Pairs of Natural Numbers *} 
 
 theory Int
-imports Equiv_Relations Nat Wellfounded
+imports Equiv_Relations Wellfounded
 uses
   ("Tools/numeral.ML")
-  ("Tools/numeral_syntax.ML")
   ("Tools/int_arith.ML")
 begin
 
@@ -323,15 +322,20 @@
 lemma of_int_of_nat_eq [simp]: "of_int (int n) = of_nat n"
 by (induct n) auto
 
+lemma of_int_numeral [simp, code_post]: "of_int (numeral k) = numeral k"
+  by (simp add: of_nat_numeral [symmetric] of_int_of_nat_eq [symmetric])
+
+lemma of_int_neg_numeral [simp, code_post]: "of_int (neg_numeral k) = neg_numeral k"
+  unfolding neg_numeral_def neg_numeral_class.neg_numeral_def
+  by (simp only: of_int_minus of_int_numeral)
+
 lemma of_int_power:
   "of_int (z ^ n) = of_int z ^ n"
   by (induct n) simp_all
 
 end
 
-text{*Class for unital rings with characteristic zero.
- Includes non-ordered rings like the complex numbers.*}
-class ring_char_0 = ring_1 + semiring_char_0
+context ring_char_0
 begin
 
 lemma of_int_eq_iff [simp]:
@@ -579,230 +583,27 @@
 apply (simp add: int_def minus add diff_minus)
 done
 
-
-subsection {* Binary representation *}
-
-text {*
-  This formalization defines binary arithmetic in terms of the integers
-  rather than using a datatype. This avoids multiple representations (leading
-  zeroes, etc.)  See @{text "ZF/Tools/twos-compl.ML"}, function @{text
-  int_of_binary}, for the numerical interpretation.
-
-  The representation expects that @{text "(m mod 2)"} is 0 or 1,
-  even if m is negative;
-  For instance, @{text "-5 div 2 = -3"} and @{text "-5 mod 2 = 1"}; thus
-  @{text "-5 = (-3)*2 + 1"}.
-  
-  This two's complement binary representation derives from the paper 
-  "An Efficient Representation of Arithmetic for Term Rewriting" by
-  Dave Cohen and Phil Watson, Rewriting Techniques and Applications,
-  Springer LNCS 488 (240-251), 1991.
-*}
-
-subsubsection {* The constructors @{term Bit0}, @{term Bit1}, @{term Pls} and @{term Min} *}
-
-definition Pls :: int where
-  "Pls = 0"
+lemma Let_numeral [simp]: "Let (numeral v) f = f (numeral v)"
+  -- {* Unfold all @{text let}s involving constants *}
+  unfolding Let_def ..
 
-definition Min :: int where
-  "Min = - 1"
-
-definition Bit0 :: "int \<Rightarrow> int" where
-  "Bit0 k = k + k"
-
-definition Bit1 :: "int \<Rightarrow> int" where
-  "Bit1 k = 1 + k + k"
-
-class number = -- {* for numeric types: nat, int, real, \dots *}
-  fixes number_of :: "int \<Rightarrow> 'a"
-
-use "Tools/numeral.ML"
-
-syntax
-  "_Numeral" :: "num_const \<Rightarrow> 'a"    ("_")
-
-use "Tools/numeral_syntax.ML"
-setup Numeral_Syntax.setup
-
-abbreviation
-  "Numeral0 \<equiv> number_of Pls"
-
-abbreviation
-  "Numeral1 \<equiv> number_of (Bit1 Pls)"
-
-lemma Let_number_of [simp]: "Let (number_of v) f = f (number_of v)"
+lemma Let_neg_numeral [simp]: "Let (neg_numeral v) f = f (neg_numeral v)"
   -- {* Unfold all @{text let}s involving constants *}
   unfolding Let_def ..
 
-definition succ :: "int \<Rightarrow> int" where
-  "succ k = k + 1"
-
-definition pred :: "int \<Rightarrow> int" where
-  "pred k = k - 1"
-
-lemmas max_number_of [simp] = max_def [of "number_of u" "number_of v"]
-  and min_number_of [simp] = min_def [of "number_of u" "number_of v"]
-  for u v
-  -- {* unfolding @{text minx} and @{text max} on numerals *}
-
-lemmas numeral_simps = 
-  succ_def pred_def Pls_def Min_def Bit0_def Bit1_def
-
-text {* Removal of leading zeroes *}
-
-lemma Bit0_Pls [simp, code_post]:
-  "Bit0 Pls = Pls"
-  unfolding numeral_simps by simp
-
-lemma Bit1_Min [simp, code_post]:
-  "Bit1 Min = Min"
-  unfolding numeral_simps by simp
-
-lemmas normalize_bin_simps =
-  Bit0_Pls Bit1_Min
-
-
-subsubsection {* Successor and predecessor functions *}
-
-text {* Successor *}
-
-lemma succ_Pls:
-  "succ Pls = Bit1 Pls"
-  unfolding numeral_simps by simp
-
-lemma succ_Min:
-  "succ Min = Pls"
-  unfolding numeral_simps by simp
-
-lemma succ_Bit0:
-  "succ (Bit0 k) = Bit1 k"
-  unfolding numeral_simps by simp
-
-lemma succ_Bit1:
-  "succ (Bit1 k) = Bit0 (succ k)"
-  unfolding numeral_simps by simp
-
-lemmas succ_bin_simps [simp] =
-  succ_Pls succ_Min succ_Bit0 succ_Bit1
-
-text {* Predecessor *}
-
-lemma pred_Pls:
-  "pred Pls = Min"
-  unfolding numeral_simps by simp
-
-lemma pred_Min:
-  "pred Min = Bit0 Min"
-  unfolding numeral_simps by simp
-
-lemma pred_Bit0:
-  "pred (Bit0 k) = Bit1 (pred k)"
-  unfolding numeral_simps by simp 
-
-lemma pred_Bit1:
-  "pred (Bit1 k) = Bit0 k"
-  unfolding numeral_simps by simp
-
-lemmas pred_bin_simps [simp] =
-  pred_Pls pred_Min pred_Bit0 pred_Bit1
-
-
-subsubsection {* Binary arithmetic *}
-
-text {* Addition *}
-
-lemma add_Pls:
-  "Pls + k = k"
-  unfolding numeral_simps by simp
-
-lemma add_Min:
-  "Min + k = pred k"
-  unfolding numeral_simps by simp
+text {* Unfold @{text min} and @{text max} on numerals. *}
 
-lemma add_Bit0_Bit0:
-  "(Bit0 k) + (Bit0 l) = Bit0 (k + l)"
-  unfolding numeral_simps by simp
-
-lemma add_Bit0_Bit1:
-  "(Bit0 k) + (Bit1 l) = Bit1 (k + l)"
-  unfolding numeral_simps by simp
-
-lemma add_Bit1_Bit0:
-  "(Bit1 k) + (Bit0 l) = Bit1 (k + l)"
-  unfolding numeral_simps by simp
-
-lemma add_Bit1_Bit1:
-  "(Bit1 k) + (Bit1 l) = Bit0 (k + succ l)"
-  unfolding numeral_simps by simp
-
-lemma add_Pls_right:
-  "k + Pls = k"
-  unfolding numeral_simps by simp
-
-lemma add_Min_right:
-  "k + Min = pred k"
-  unfolding numeral_simps by simp
-
-lemmas add_bin_simps [simp] =
-  add_Pls add_Min add_Pls_right add_Min_right
-  add_Bit0_Bit0 add_Bit0_Bit1 add_Bit1_Bit0 add_Bit1_Bit1
-
-text {* Negation *}
-
-lemma minus_Pls:
-  "- Pls = Pls"
-  unfolding numeral_simps by simp
-
-lemma minus_Min:
-  "- Min = Bit1 Pls"
-  unfolding numeral_simps by simp
-
-lemma minus_Bit0:
-  "- (Bit0 k) = Bit0 (- k)"
-  unfolding numeral_simps by simp
+lemmas max_number_of [simp] =
+  max_def [of "numeral u" "numeral v"]
+  max_def [of "numeral u" "neg_numeral v"]
+  max_def [of "neg_numeral u" "numeral v"]
+  max_def [of "neg_numeral u" "neg_numeral v"] for u v
 
-lemma minus_Bit1:
-  "- (Bit1 k) = Bit1 (pred (- k))"
-  unfolding numeral_simps by simp
-
-lemmas minus_bin_simps [simp] =
-  minus_Pls minus_Min minus_Bit0 minus_Bit1
-
-text {* Subtraction *}
-
-lemma diff_bin_simps [simp]:
-  "k - Pls = k"
-  "k - Min = succ k"
-  "Pls - (Bit0 l) = Bit0 (Pls - l)"
-  "Pls - (Bit1 l) = Bit1 (Min - l)"
-  "Min - (Bit0 l) = Bit1 (Min - l)"
-  "Min - (Bit1 l) = Bit0 (Min - l)"
-  "(Bit0 k) - (Bit0 l) = Bit0 (k - l)"
-  "(Bit0 k) - (Bit1 l) = Bit1 (pred k - l)"
-  "(Bit1 k) - (Bit0 l) = Bit1 (k - l)"
-  "(Bit1 k) - (Bit1 l) = Bit0 (k - l)"
-  unfolding numeral_simps by simp_all
-
-text {* Multiplication *}
-
-lemma mult_Pls:
-  "Pls * w = Pls"
-  unfolding numeral_simps by simp
-
-lemma mult_Min:
-  "Min * k = - k"
-  unfolding numeral_simps by simp
-
-lemma mult_Bit0:
-  "(Bit0 k) * l = Bit0 (k * l)"
-  unfolding numeral_simps int_distrib by simp
-
-lemma mult_Bit1:
-  "(Bit1 k) * l = (Bit0 (k * l)) + l"
-  unfolding numeral_simps int_distrib by simp
-
-lemmas mult_bin_simps [simp] =
-  mult_Pls mult_Min mult_Bit0 mult_Bit1
+lemmas min_number_of [simp] =
+  min_def [of "numeral u" "numeral v"]
+  min_def [of "numeral u" "neg_numeral v"]
+  min_def [of "neg_numeral u" "numeral v"]
+  min_def [of "neg_numeral u" "neg_numeral v"] for u v
 
 
 subsubsection {* Binary comparisons *}
@@ -812,7 +613,7 @@
 lemma even_less_0_iff:
   "a + a < 0 \<longleftrightarrow> a < (0::'a::linordered_idom)"
 proof -
-  have "a + a < 0 \<longleftrightarrow> (1+1)*a < 0" by (simp add: left_distrib)
+  have "a + a < 0 \<longleftrightarrow> (1+1)*a < 0" by (simp add: left_distrib del: one_add_one)
   also have "(1+1)*a < 0 \<longleftrightarrow> a < 0"
     by (simp add: mult_less_0_iff zero_less_two 
                   order_less_not_sym [OF zero_less_two])
@@ -824,7 +625,7 @@
   shows "(0::int) < 1 + z"
 proof -
   have "0 \<le> z" by fact
-  also have "... < z + 1" by (rule less_add_one) 
+  also have "... < z + 1" by (rule less_add_one)
   also have "... = 1 + z" by (simp add: add_ac)
   finally show "0 < 1 + z" .
 qed
@@ -841,276 +642,6 @@
     add: algebra_simps of_nat_1 [where 'a=int, symmetric] of_nat_add [symmetric])
 qed
 
-lemma bin_less_0_simps:
-  "Pls < 0 \<longleftrightarrow> False"
-  "Min < 0 \<longleftrightarrow> True"
-  "Bit0 w < 0 \<longleftrightarrow> w < 0"
-  "Bit1 w < 0 \<longleftrightarrow> w < 0"
-  unfolding numeral_simps
-  by (simp_all add: even_less_0_iff odd_less_0_iff)
-
-lemma less_bin_lemma: "k < l \<longleftrightarrow> k - l < (0::int)"
-  by simp
-
-lemma le_iff_pred_less: "k \<le> l \<longleftrightarrow> pred k < l"
-  unfolding numeral_simps
-  proof
-    have "k - 1 < k" by simp
-    also assume "k \<le> l"
-    finally show "k - 1 < l" .
-  next
-    assume "k - 1 < l"
-    hence "(k - 1) + 1 \<le> l" by (rule zless_imp_add1_zle)
-    thus "k \<le> l" by simp
-  qed
-
-lemma succ_pred: "succ (pred x) = x"
-  unfolding numeral_simps by simp
-
-text {* Less-than *}
-
-lemma less_bin_simps [simp]:
-  "Pls < Pls \<longleftrightarrow> False"
-  "Pls < Min \<longleftrightarrow> False"
-  "Pls < Bit0 k \<longleftrightarrow> Pls < k"
-  "Pls < Bit1 k \<longleftrightarrow> Pls \<le> k"
-  "Min < Pls \<longleftrightarrow> True"
-  "Min < Min \<longleftrightarrow> False"
-  "Min < Bit0 k \<longleftrightarrow> Min < k"
-  "Min < Bit1 k \<longleftrightarrow> Min < k"
-  "Bit0 k < Pls \<longleftrightarrow> k < Pls"
-  "Bit0 k < Min \<longleftrightarrow> k \<le> Min"
-  "Bit1 k < Pls \<longleftrightarrow> k < Pls"
-  "Bit1 k < Min \<longleftrightarrow> k < Min"
-  "Bit0 k < Bit0 l \<longleftrightarrow> k < l"
-  "Bit0 k < Bit1 l \<longleftrightarrow> k \<le> l"
-  "Bit1 k < Bit0 l \<longleftrightarrow> k < l"
-  "Bit1 k < Bit1 l \<longleftrightarrow> k < l"
-  unfolding le_iff_pred_less
-    less_bin_lemma [of Pls]
-    less_bin_lemma [of Min]
-    less_bin_lemma [of "k"]
-    less_bin_lemma [of "Bit0 k"]
-    less_bin_lemma [of "Bit1 k"]
-    less_bin_lemma [of "pred Pls"]
-    less_bin_lemma [of "pred k"]
-  by (simp_all add: bin_less_0_simps succ_pred)
-
-text {* Less-than-or-equal *}
-
-lemma le_bin_simps [simp]:
-  "Pls \<le> Pls \<longleftrightarrow> True"
-  "Pls \<le> Min \<longleftrightarrow> False"
-  "Pls \<le> Bit0 k \<longleftrightarrow> Pls \<le> k"
-  "Pls \<le> Bit1 k \<longleftrightarrow> Pls \<le> k"
-  "Min \<le> Pls \<longleftrightarrow> True"
-  "Min \<le> Min \<longleftrightarrow> True"
-  "Min \<le> Bit0 k \<longleftrightarrow> Min < k"
-  "Min \<le> Bit1 k \<longleftrightarrow> Min \<le> k"
-  "Bit0 k \<le> Pls \<longleftrightarrow> k \<le> Pls"
-  "Bit0 k \<le> Min \<longleftrightarrow> k \<le> Min"
-  "Bit1 k \<le> Pls \<longleftrightarrow> k < Pls"
-  "Bit1 k \<le> Min \<longleftrightarrow> k \<le> Min"
-  "Bit0 k \<le> Bit0 l \<longleftrightarrow> k \<le> l"
-  "Bit0 k \<le> Bit1 l \<longleftrightarrow> k \<le> l"
-  "Bit1 k \<le> Bit0 l \<longleftrightarrow> k < l"
-  "Bit1 k \<le> Bit1 l \<longleftrightarrow> k \<le> l"
-  unfolding not_less [symmetric]
-  by (simp_all add: not_le)
-
-text {* Equality *}
-
-lemma eq_bin_simps [simp]:
-  "Pls = Pls \<longleftrightarrow> True"
-  "Pls = Min \<longleftrightarrow> False"
-  "Pls = Bit0 l \<longleftrightarrow> Pls = l"
-  "Pls = Bit1 l \<longleftrightarrow> False"
-  "Min = Pls \<longleftrightarrow> False"
-  "Min = Min \<longleftrightarrow> True"
-  "Min = Bit0 l \<longleftrightarrow> False"
-  "Min = Bit1 l \<longleftrightarrow> Min = l"
-  "Bit0 k = Pls \<longleftrightarrow> k = Pls"
-  "Bit0 k = Min \<longleftrightarrow> False"
-  "Bit1 k = Pls \<longleftrightarrow> False"
-  "Bit1 k = Min \<longleftrightarrow> k = Min"
-  "Bit0 k = Bit0 l \<longleftrightarrow> k = l"
-  "Bit0 k = Bit1 l \<longleftrightarrow> False"
-  "Bit1 k = Bit0 l \<longleftrightarrow> False"
-  "Bit1 k = Bit1 l \<longleftrightarrow> k = l"
-  unfolding order_eq_iff [where 'a=int]
-  by (simp_all add: not_less)
-
-
-subsection {* Converting Numerals to Rings: @{term number_of} *}
-
-class number_ring = number + comm_ring_1 +
-  assumes number_of_eq: "number_of k = of_int k"
-
-class number_semiring = number + comm_semiring_1 +
-  assumes number_of_int: "number_of (int n) = of_nat n"
-
-instance number_ring \<subseteq> number_semiring
-proof
-  fix n show "number_of (int n) = (of_nat n :: 'a)"
-    unfolding number_of_eq by (rule of_int_of_nat_eq)
-qed
-
-text {* self-embedding of the integers *}
-
-instantiation int :: number_ring
-begin
-
-definition
-  int_number_of_def: "number_of w = (of_int w \<Colon> int)"
-
-instance proof
-qed (simp only: int_number_of_def)
-
-end
-
-lemma number_of_is_id:
-  "number_of (k::int) = k"
-  unfolding int_number_of_def by simp
-
-lemma number_of_succ:
-  "number_of (succ k) = (1 + number_of k ::'a::number_ring)"
-  unfolding number_of_eq numeral_simps by simp
-
-lemma number_of_pred:
-  "number_of (pred w) = (- 1 + number_of w ::'a::number_ring)"
-  unfolding number_of_eq numeral_simps by simp
-
-lemma number_of_minus:
-  "number_of (uminus w) = (- (number_of w)::'a::number_ring)"
-  unfolding number_of_eq by (rule of_int_minus)
-
-lemma number_of_add:
-  "number_of (v + w) = (number_of v + number_of w::'a::number_ring)"
-  unfolding number_of_eq by (rule of_int_add)
-
-lemma number_of_diff:
-  "number_of (v - w) = (number_of v - number_of w::'a::number_ring)"
-  unfolding number_of_eq by (rule of_int_diff)
-
-lemma number_of_mult:
-  "number_of (v * w) = (number_of v * number_of w::'a::number_ring)"
-  unfolding number_of_eq by (rule of_int_mult)
-
-text {*
-  The correctness of shifting.
-  But it doesn't seem to give a measurable speed-up.
-*}
-
-lemma double_number_of_Bit0:
-  "(1 + 1) * number_of w = (number_of (Bit0 w) ::'a::number_ring)"
-  unfolding number_of_eq numeral_simps left_distrib by simp
-
-text {*
-  Converting numerals 0 and 1 to their abstract versions.
-*}
-
-lemma semiring_numeral_0_eq_0 [simp, code_post]:
-  "Numeral0 = (0::'a::number_semiring)"
-  using number_of_int [where 'a='a and n=0]
-  unfolding numeral_simps by simp
-
-lemma semiring_numeral_1_eq_1 [simp, code_post]:
-  "Numeral1 = (1::'a::number_semiring)"
-  using number_of_int [where 'a='a and n=1]
-  unfolding numeral_simps by simp
-
-lemma numeral_0_eq_0: (* FIXME delete candidate *)
-  "Numeral0 = (0::'a::number_ring)"
-  by (rule semiring_numeral_0_eq_0)
-
-lemma numeral_1_eq_1: (* FIXME delete candidate *)
-  "Numeral1 = (1::'a::number_ring)"
-  by (rule semiring_numeral_1_eq_1)
-
-text {*
-  Special-case simplification for small constants.
-*}
-
-text{*
-  Unary minus for the abstract constant 1. Cannot be inserted
-  as a simprule until later: it is @{text number_of_Min} re-oriented!
-*}
-
-lemma numeral_m1_eq_minus_1:
-  "(-1::'a::number_ring) = - 1"
-  unfolding number_of_eq numeral_simps by simp
-
-lemma mult_minus1 [simp]:
-  "-1 * z = -(z::'a::number_ring)"
-  unfolding number_of_eq numeral_simps by simp
-
-lemma mult_minus1_right [simp]:
-  "z * -1 = -(z::'a::number_ring)"
-  unfolding number_of_eq numeral_simps by simp
-
-(*Negation of a coefficient*)
-lemma minus_number_of_mult [simp]:
-   "- (number_of w) * z = number_of (uminus w) * (z::'a::number_ring)"
-   unfolding number_of_eq by simp
-
-text {* Subtraction *}
-
-lemma diff_number_of_eq:
-  "number_of v - number_of w =
-    (number_of (v + uminus w)::'a::number_ring)"
-  unfolding number_of_eq by simp
-
-lemma number_of_Pls:
-  "number_of Pls = (0::'a::number_ring)"
-  unfolding number_of_eq numeral_simps by simp
-
-lemma number_of_Min:
-  "number_of Min = (- 1::'a::number_ring)"
-  unfolding number_of_eq numeral_simps by simp
-
-lemma number_of_Bit0:
-  "number_of (Bit0 w) = (0::'a::number_ring) + (number_of w) + (number_of w)"
-  unfolding number_of_eq numeral_simps by simp
-
-lemma number_of_Bit1:
-  "number_of (Bit1 w) = (1::'a::number_ring) + (number_of w) + (number_of w)"
-  unfolding number_of_eq numeral_simps by simp
-
-
-subsubsection {* Equality of Binary Numbers *}
-
-text {* First version by Norbert Voelker *}
-
-definition (*for simplifying equalities*) iszero :: "'a\<Colon>semiring_1 \<Rightarrow> bool" where
-  "iszero z \<longleftrightarrow> z = 0"
-
-lemma iszero_0: "iszero 0"
-  by (simp add: iszero_def)
-
-lemma iszero_Numeral0: "iszero (Numeral0 :: 'a::number_ring)"
-  by (simp add: iszero_0)
-
-lemma not_iszero_1: "\<not> iszero 1"
-  by (simp add: iszero_def)
-
-lemma not_iszero_Numeral1: "\<not> iszero (Numeral1 :: 'a::number_ring)"
-  by (simp add: not_iszero_1)
-
-lemma eq_number_of_eq [simp]:
-  "((number_of x::'a::number_ring) = number_of y) =
-     iszero (number_of (x + uminus y) :: 'a)"
-unfolding iszero_def number_of_add number_of_minus
-by (simp add: algebra_simps)
-
-lemma iszero_number_of_Pls:
-  "iszero ((number_of Pls)::'a::number_ring)"
-unfolding iszero_def numeral_0_eq_0 ..
-
-lemma nonzero_number_of_Min:
-  "~ iszero ((number_of Min)::'a::number_ring)"
-unfolding iszero_def numeral_m1_eq_minus_1 by simp
-
-
 subsubsection {* Comparisons, for Ordered Rings *}
 
 lemmas double_eq_0_iff = double_zero
@@ -1137,129 +668,6 @@
   qed
 qed
 
-lemma iszero_number_of_Bit0:
-  "iszero (number_of (Bit0 w)::'a) = 
-   iszero (number_of w::'a::{ring_char_0,number_ring})"
-proof -
-  have "(of_int w + of_int w = (0::'a)) \<Longrightarrow> (w = 0)"
-  proof -
-    assume eq: "of_int w + of_int w = (0::'a)"
-    then have "of_int (w + w) = (of_int 0 :: 'a)" by simp
-    then have "w + w = 0" by (simp only: of_int_eq_iff)
-    then show "w = 0" by (simp only: double_eq_0_iff)
-  qed
-  thus ?thesis
-    by (auto simp add: iszero_def number_of_eq numeral_simps)
-qed
-
-lemma iszero_number_of_Bit1:
-  "~ iszero (number_of (Bit1 w)::'a::{ring_char_0,number_ring})"
-proof -
-  have "1 + of_int w + of_int w \<noteq> (0::'a)"
-  proof
-    assume eq: "1 + of_int w + of_int w = (0::'a)"
-    hence "of_int (1 + w + w) = (of_int 0 :: 'a)" by simp 
-    hence "1 + w + w = 0" by (simp only: of_int_eq_iff)
-    with odd_nonzero show False by blast
-  qed
-  thus ?thesis
-    by (auto simp add: iszero_def number_of_eq numeral_simps)
-qed
-
-lemmas iszero_simps [simp] =
-  iszero_0 not_iszero_1
-  iszero_number_of_Pls nonzero_number_of_Min
-  iszero_number_of_Bit0 iszero_number_of_Bit1
-(* iszero_number_of_Pls would never normally be used
-   because its lhs simplifies to "iszero 0" *)
-
-text {* Less-Than or Equals *}
-
-text {* Reduces @{term "a\<le>b"} to @{term "~ (b<a)"} for ALL numerals. *}
-
-lemmas le_number_of_eq_not_less =
-  linorder_not_less [of "number_of w" "number_of v", symmetric] for w v
-
-
-text {* Absolute value (@{term abs}) *}
-
-lemma abs_number_of:
-  "abs(number_of x::'a::{linordered_idom,number_ring}) =
-   (if number_of x < (0::'a) then -number_of x else number_of x)"
-  by (simp add: abs_if)
-
-
-text {* Re-orientation of the equation nnn=x *}
-
-lemma number_of_reorient:
-  "(number_of w = x) = (x = number_of w)"
-  by auto
-
-
-subsubsection {* Simplification of arithmetic operations on integer constants. *}
-
-lemmas arith_extra_simps [simp] =
-  number_of_add [symmetric]
-  number_of_minus [symmetric]
-  numeral_m1_eq_minus_1 [symmetric]
-  number_of_mult [symmetric]
-  diff_number_of_eq abs_number_of
-
-text {*
-  For making a minimal simpset, one must include these default simprules.
-  Also include @{text simp_thms}.
-*}
-
-lemmas arith_simps = 
-  normalize_bin_simps pred_bin_simps succ_bin_simps
-  add_bin_simps minus_bin_simps mult_bin_simps
-  abs_zero abs_one arith_extra_simps
-
-text {* Simplification of relational operations *}
-
-lemma less_number_of [simp]:
-  "(number_of x::'a::{linordered_idom,number_ring}) < number_of y \<longleftrightarrow> x < y"
-  unfolding number_of_eq by (rule of_int_less_iff)
-
-lemma le_number_of [simp]:
-  "(number_of x::'a::{linordered_idom,number_ring}) \<le> number_of y \<longleftrightarrow> x \<le> y"
-  unfolding number_of_eq by (rule of_int_le_iff)
-
-lemma eq_number_of [simp]:
-  "(number_of x::'a::{ring_char_0,number_ring}) = number_of y \<longleftrightarrow> x = y"
-  unfolding number_of_eq by (rule of_int_eq_iff)
-
-lemmas rel_simps =
-  less_number_of less_bin_simps
-  le_number_of le_bin_simps
-  eq_number_of_eq eq_bin_simps
-  iszero_simps
-
-
-subsubsection {* Simplification of arithmetic when nested to the right. *}
-
-lemma add_number_of_left [simp]:
-  "number_of v + (number_of w + z) =
-   (number_of(v + w) + z::'a::number_ring)"
-  by (simp add: add_assoc [symmetric])
-
-lemma mult_number_of_left [simp]:
-  "number_of v * (number_of w * z) =
-   (number_of(v * w) * z::'a::number_ring)"
-  by (simp add: mult_assoc [symmetric])
-
-lemma add_number_of_diff1:
-  "number_of v + (number_of w - c) = 
-  number_of(v + w) - (c::'a::number_ring)"
-  by (simp add: diff_minus)
-
-lemma add_number_of_diff2 [simp]:
-  "number_of v + (c - number_of w) =
-   number_of (v + uminus w) + (c::'a::number_ring)"
-by (simp add: algebra_simps diff_number_of_eq [symmetric])
-
-
-
 
 subsection {* The Set of Integers *}
 
@@ -1363,14 +771,8 @@
   qed
 qed 
 
-lemma Ints_number_of [simp]:
-  "(number_of w :: 'a::number_ring) \<in> Ints"
-  unfolding number_of_eq Ints_def by simp
-
-lemma Nats_number_of [simp]:
-  "Int.Pls \<le> w \<Longrightarrow> (number_of w :: 'a::number_ring) \<in> Nats"
-unfolding Int.Pls_def number_of_eq
-by (simp only: of_nat_nat [symmetric] of_nat_in_Nats)
+lemma Nats_numeral [simp]: "numeral w \<in> Nats"
+  using of_nat_in_Nats [of "numeral w"] by simp
 
 lemma Ints_odd_less_0: 
   assumes in_Ints: "a \<in> Ints"
@@ -1412,100 +814,16 @@
 lemmas int_setprod = of_nat_setprod [where 'a=int]
 
 
-subsection{*Inequality Reasoning for the Arithmetic Simproc*}
-
-lemma add_numeral_0: "Numeral0 + a = (a::'a::number_ring)"
-by simp 
-
-lemma add_numeral_0_right: "a + Numeral0 = (a::'a::number_ring)"
-by simp
-
-lemma mult_numeral_1: "Numeral1 * a = (a::'a::number_ring)"
-by simp 
-
-lemma mult_numeral_1_right: "a * Numeral1 = (a::'a::number_ring)"
-by simp
-
-lemma divide_numeral_1: "a / Numeral1 = (a::'a::{number_ring,field})"
-by simp
-
-lemma inverse_numeral_1:
-  "inverse Numeral1 = (Numeral1::'a::{number_ring,field})"
-by simp
-
-text{*Theorem lists for the cancellation simprocs. The use of binary numerals
-for 0 and 1 reduces the number of special cases.*}
-
-lemmas add_0s = add_numeral_0 add_numeral_0_right
-lemmas mult_1s = mult_numeral_1 mult_numeral_1_right 
-                 mult_minus1 mult_minus1_right
-
-
-subsection{*Special Arithmetic Rules for Abstract 0 and 1*}
-
-text{*Arithmetic computations are defined for binary literals, which leaves 0
-and 1 as special cases. Addition already has rules for 0, but not 1.
-Multiplication and unary minus already have rules for both 0 and 1.*}
-
-
-lemma binop_eq: "[|f x y = g x y; x = x'; y = y'|] ==> f x' y' = g x' y'"
-by simp
-
-
-lemmas add_number_of_eq = number_of_add [symmetric]
-
-text{*Allow 1 on either or both sides*}
-lemma semiring_one_add_one_is_two: "1 + 1 = (2::'a::number_semiring)"
-  using number_of_int [where 'a='a and n="Suc (Suc 0)"]
-  by (simp add: numeral_simps)
-
-lemma one_add_one_is_two: "1 + 1 = (2::'a::number_ring)"
-by (rule semiring_one_add_one_is_two)
-
-lemmas add_special =
-    one_add_one_is_two
-    binop_eq [of "op +", OF add_number_of_eq numeral_1_eq_1 refl]
-    binop_eq [of "op +", OF add_number_of_eq refl numeral_1_eq_1]
-
-text{*Allow 1 on either or both sides (1-1 already simplifies to 0)*}
-lemmas diff_special =
-    binop_eq [of "op -", OF diff_number_of_eq numeral_1_eq_1 refl]
-    binop_eq [of "op -", OF diff_number_of_eq refl numeral_1_eq_1]
-
-text{*Allow 0 or 1 on either side with a binary numeral on the other*}
-lemmas eq_special =
-    binop_eq [of "op =", OF eq_number_of_eq numeral_0_eq_0 refl]
-    binop_eq [of "op =", OF eq_number_of_eq numeral_1_eq_1 refl]
-    binop_eq [of "op =", OF eq_number_of_eq refl numeral_0_eq_0]
-    binop_eq [of "op =", OF eq_number_of_eq refl numeral_1_eq_1]
-
-text{*Allow 0 or 1 on either side with a binary numeral on the other*}
-lemmas less_special =
-  binop_eq [of "op <", OF less_number_of numeral_0_eq_0 refl]
-  binop_eq [of "op <", OF less_number_of numeral_1_eq_1 refl]
-  binop_eq [of "op <", OF less_number_of refl numeral_0_eq_0]
-  binop_eq [of "op <", OF less_number_of refl numeral_1_eq_1]
-
-text{*Allow 0 or 1 on either side with a binary numeral on the other*}
-lemmas le_special =
-    binop_eq [of "op \<le>", OF le_number_of numeral_0_eq_0 refl]
-    binop_eq [of "op \<le>", OF le_number_of numeral_1_eq_1 refl]
-    binop_eq [of "op \<le>", OF le_number_of refl numeral_0_eq_0]
-    binop_eq [of "op \<le>", OF le_number_of refl numeral_1_eq_1]
-
-lemmas arith_special[simp] = 
-       add_special diff_special eq_special less_special le_special
-
-
 text {* Legacy theorems *}
 
 lemmas zle_int = of_nat_le_iff [where 'a=int]
 lemmas int_int_eq = of_nat_eq_iff [where 'a=int]
+lemmas numeral_1_eq_1 = numeral_One
 
 subsection {* Setting up simplification procedures *}
 
 lemmas int_arith_rules =
-  neg_le_iff_le numeral_0_eq_0 numeral_1_eq_1
+  neg_le_iff_le numeral_One
   minus_zero diff_minus left_minus right_minus
   mult_zero_left mult_zero_right mult_1_left mult_1_right
   mult_minus_left mult_minus_right
@@ -1513,56 +831,39 @@
   of_nat_0 of_nat_1 of_nat_Suc of_nat_add of_nat_mult
   of_int_0 of_int_1 of_int_add of_int_mult
 
+use "Tools/numeral.ML"
 use "Tools/int_arith.ML"
 declaration {* K Int_Arith.setup *}
 
-simproc_setup fast_arith ("(m::'a::{linordered_idom,number_ring}) < n" |
-  "(m::'a::{linordered_idom,number_ring}) <= n" |
-  "(m::'a::{linordered_idom,number_ring}) = n") =
+simproc_setup fast_arith ("(m::'a::linordered_idom) < n" |
+  "(m::'a::linordered_idom) <= n" |
+  "(m::'a::linordered_idom) = n") =
   {* fn _ => fn ss => fn ct => Lin_Arith.simproc ss (term_of ct) *}
 
 setup {*
   Reorient_Proc.add
-    (fn Const (@{const_name number_of}, _) $ _ => true | _ => false)
+    (fn Const (@{const_name numeral}, _) $ _ => true
+    | Const (@{const_name neg_numeral}, _) $ _ => true
+    | _ => false)
 *}
 
-simproc_setup reorient_numeral ("number_of w = x") = Reorient_Proc.proc
+simproc_setup reorient_numeral
+  ("numeral w = x" | "neg_numeral w = y") = Reorient_Proc.proc
 
 
 subsection{*Lemmas About Small Numerals*}
 
-lemma of_int_m1 [simp]: "of_int -1 = (-1 :: 'a :: number_ring)"
-proof -
-  have "(of_int -1 :: 'a) = of_int (- 1)" by simp
-  also have "... = - of_int 1" by (simp only: of_int_minus)
-  also have "... = -1" by simp
-  finally show ?thesis .
-qed
-
-lemma abs_minus_one [simp]: "abs (-1) = (1::'a::{linordered_idom,number_ring})"
-by (simp add: abs_if)
-
 lemma abs_power_minus_one [simp]:
-  "abs(-1 ^ n) = (1::'a::{linordered_idom,number_ring})"
+  "abs(-1 ^ n) = (1::'a::linordered_idom)"
 by (simp add: power_abs)
 
-lemma of_int_number_of_eq [simp]:
-     "of_int (number_of v) = (number_of v :: 'a :: number_ring)"
-by (simp add: number_of_eq) 
-
 text{*Lemmas for specialist use, NOT as default simprules*}
 (* TODO: see if semiring duplication can be removed without breaking proofs *)
-lemma semiring_mult_2: "2 * z = (z+z::'a::number_semiring)"
-unfolding semiring_one_add_one_is_two [symmetric] left_distrib by simp
-
-lemma semiring_mult_2_right: "z * 2 = (z+z::'a::number_semiring)"
-by (subst mult_commute, rule semiring_mult_2)
+lemma mult_2: "2 * z = (z+z::'a::semiring_1)"
+unfolding one_add_one [symmetric] left_distrib by simp
 
-lemma mult_2: "2 * z = (z+z::'a::number_ring)"
-by (rule semiring_mult_2)
-
-lemma mult_2_right: "z * 2 = (z+z::'a::number_ring)"
-by (rule semiring_mult_2_right)
+lemma mult_2_right: "z * 2 = (z+z::'a::semiring_1)"
+unfolding one_add_one [symmetric] right_distrib by simp
 
 
 subsection{*More Inequality Reasoning*}
@@ -1608,7 +909,7 @@
 
 text{*This simplifies expressions of the form @{term "int n = z"} where
       z is an integer literal.*}
-lemmas int_eq_iff_number_of [simp] = int_eq_iff [of _ "number_of v"] for v
+lemmas int_eq_iff_numeral [simp] = int_eq_iff [of _ "numeral v"] for v
 
 lemma split_nat [arith_split]:
   "P(nat(i::int)) = ((\<forall>n. i = int n \<longrightarrow> P n) & (i < 0 \<longrightarrow> P 0))"
@@ -1853,12 +1154,14 @@
       by (simp add: mn)
     finally have "2*\<bar>n\<bar> \<le> 1" .
     thus "False" using 0
-      by auto
+      by arith
   qed
   thus ?thesis using 0
     by auto
 qed
 
+ML_val {* @{const_name neg_numeral} *}
+
 lemma pos_zmult_eq_1_iff_lemma: "(m * n = 1) ==> m = (1::int) | m = -1"
 by (insert abs_zmult_eq_1 [of m n], arith)
 
@@ -1894,125 +1197,170 @@
 
 text{*These distributive laws move literals inside sums and differences.*}
 
-lemmas left_distrib_number_of [simp] = left_distrib [of _ _ "number_of v"] for v
-lemmas right_distrib_number_of [simp] = right_distrib [of "number_of v"] for v
-lemmas left_diff_distrib_number_of [simp] = left_diff_distrib [of _ _ "number_of v"] for v
-lemmas right_diff_distrib_number_of [simp] = right_diff_distrib [of "number_of v"] for v
+lemmas left_distrib_numeral [simp] = left_distrib [of _ _ "numeral v"] for v
+lemmas right_distrib_numeral [simp] = right_distrib [of "numeral v"] for v
+lemmas left_diff_distrib_numeral [simp] = left_diff_distrib [of _ _ "numeral v"] for v
+lemmas right_diff_distrib_numeral [simp] = right_diff_distrib [of "numeral v"] for v
 
 text{*These are actually for fields, like real: but where else to put them?*}
 
-lemmas zero_less_divide_iff_number_of [simp, no_atp] = zero_less_divide_iff [of "number_of w"] for w
-lemmas divide_less_0_iff_number_of [simp, no_atp] = divide_less_0_iff [of "number_of w"] for w
-lemmas zero_le_divide_iff_number_of [simp, no_atp] = zero_le_divide_iff [of "number_of w"] for w
-lemmas divide_le_0_iff_number_of [simp, no_atp] = divide_le_0_iff [of "number_of w"] for w
+lemmas zero_less_divide_iff_numeral [simp, no_atp] = zero_less_divide_iff [of "numeral w"] for w
+lemmas divide_less_0_iff_numeral [simp, no_atp] = divide_less_0_iff [of "numeral w"] for w
+lemmas zero_le_divide_iff_numeral [simp, no_atp] = zero_le_divide_iff [of "numeral w"] for w
+lemmas divide_le_0_iff_numeral [simp, no_atp] = divide_le_0_iff [of "numeral w"] for w
 
 
 text {*Replaces @{text "inverse #nn"} by @{text "1/#nn"}.  It looks
   strange, but then other simprocs simplify the quotient.*}
 
-lemmas inverse_eq_divide_number_of [simp] = inverse_eq_divide [of "number_of w"] for w
+lemmas inverse_eq_divide_numeral [simp] =
+  inverse_eq_divide [of "numeral w"] for w
+
+lemmas inverse_eq_divide_neg_numeral [simp] =
+  inverse_eq_divide [of "neg_numeral w"] for w
 
 text {*These laws simplify inequalities, moving unary minus from a term
 into the literal.*}
 
-lemmas less_minus_iff_number_of [simp, no_atp] = less_minus_iff [of "number_of v"] for v
-lemmas le_minus_iff_number_of [simp, no_atp] = le_minus_iff [of "number_of v"] for v
-lemmas equation_minus_iff_number_of [simp, no_atp] = equation_minus_iff [of "number_of v"] for v
-lemmas minus_less_iff_number_of [simp, no_atp] = minus_less_iff [of _ "number_of v"] for v
-lemmas minus_le_iff_number_of [simp, no_atp] = minus_le_iff [of _ "number_of v"] for v
-lemmas minus_equation_iff_number_of [simp, no_atp] = minus_equation_iff [of _ "number_of v"] for v
+lemmas le_minus_iff_numeral [simp, no_atp] =
+  le_minus_iff [of "numeral v"]
+  le_minus_iff [of "neg_numeral v"] for v
+
+lemmas equation_minus_iff_numeral [simp, no_atp] =
+  equation_minus_iff [of "numeral v"]
+  equation_minus_iff [of "neg_numeral v"] for v
+
+lemmas minus_less_iff_numeral [simp, no_atp] =
+  minus_less_iff [of _ "numeral v"]
+  minus_less_iff [of _ "neg_numeral v"] for v
+
+lemmas minus_le_iff_numeral [simp, no_atp] =
+  minus_le_iff [of _ "numeral v"]
+  minus_le_iff [of _ "neg_numeral v"] for v
+
+lemmas minus_equation_iff_numeral [simp, no_atp] =
+  minus_equation_iff [of _ "numeral v"]
+  minus_equation_iff [of _ "neg_numeral v"] for v
 
 text{*To Simplify Inequalities Where One Side is the Constant 1*}
 
 lemma less_minus_iff_1 [simp,no_atp]:
-  fixes b::"'b::{linordered_idom,number_ring}"
+  fixes b::"'b::linordered_idom"
   shows "(1 < - b) = (b < -1)"
 by auto
 
 lemma le_minus_iff_1 [simp,no_atp]:
-  fixes b::"'b::{linordered_idom,number_ring}"
+  fixes b::"'b::linordered_idom"
   shows "(1 \<le> - b) = (b \<le> -1)"
 by auto
 
 lemma equation_minus_iff_1 [simp,no_atp]:
-  fixes b::"'b::number_ring"
+  fixes b::"'b::ring_1"
   shows "(1 = - b) = (b = -1)"
 by (subst equation_minus_iff, auto)
 
 lemma minus_less_iff_1 [simp,no_atp]:
-  fixes a::"'b::{linordered_idom,number_ring}"
+  fixes a::"'b::linordered_idom"
   shows "(- a < 1) = (-1 < a)"
 by auto
 
 lemma minus_le_iff_1 [simp,no_atp]:
-  fixes a::"'b::{linordered_idom,number_ring}"
+  fixes a::"'b::linordered_idom"
   shows "(- a \<le> 1) = (-1 \<le> a)"
 by auto
 
 lemma minus_equation_iff_1 [simp,no_atp]:
-  fixes a::"'b::number_ring"
+  fixes a::"'b::ring_1"
   shows "(- a = 1) = (a = -1)"
 by (subst minus_equation_iff, auto)
 
 
 text {*Cancellation of constant factors in comparisons (@{text "<"} and @{text "\<le>"}) *}
 
-lemmas mult_less_cancel_left_number_of [simp, no_atp] = mult_less_cancel_left [of "number_of v"] for v
-lemmas mult_less_cancel_right_number_of [simp, no_atp] = mult_less_cancel_right [of _ "number_of v"] for v
-lemmas mult_le_cancel_left_number_of [simp, no_atp] = mult_le_cancel_left [of "number_of v"] for v
-lemmas mult_le_cancel_right_number_of [simp, no_atp] = mult_le_cancel_right [of _ "number_of v"] for v
+lemmas mult_less_cancel_left_numeral [simp, no_atp] = mult_less_cancel_left [of "numeral v"] for v
+lemmas mult_less_cancel_right_numeral [simp, no_atp] = mult_less_cancel_right [of _ "numeral v"] for v
+lemmas mult_le_cancel_left_numeral [simp, no_atp] = mult_le_cancel_left [of "numeral v"] for v
+lemmas mult_le_cancel_right_numeral [simp, no_atp] = mult_le_cancel_right [of _ "numeral v"] for v
 
 
 text {*Multiplying out constant divisors in comparisons (@{text "<"}, @{text "\<le>"} and @{text "="}) *}
 
-lemmas le_divide_eq_number_of1 [simp] = le_divide_eq [of _ _ "number_of w"] for w
-lemmas divide_le_eq_number_of1 [simp] = divide_le_eq [of _ "number_of w"] for w
-lemmas less_divide_eq_number_of1 [simp] = less_divide_eq [of _ _ "number_of w"] for w
-lemmas divide_less_eq_number_of1 [simp] = divide_less_eq [of _ "number_of w"] for w
-lemmas eq_divide_eq_number_of1 [simp] = eq_divide_eq [of _ _ "number_of w"] for w
-lemmas divide_eq_eq_number_of1 [simp] = divide_eq_eq [of _ "number_of w"] for w
+lemmas le_divide_eq_numeral1 [simp] =
+  pos_le_divide_eq [of "numeral w", OF zero_less_numeral]
+  neg_le_divide_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
+
+lemmas divide_le_eq_numeral1 [simp] =
+  pos_divide_le_eq [of "numeral w", OF zero_less_numeral]
+  neg_divide_le_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
+
+lemmas less_divide_eq_numeral1 [simp] =
+  pos_less_divide_eq [of "numeral w", OF zero_less_numeral]
+  neg_less_divide_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
 
+lemmas divide_less_eq_numeral1 [simp] =
+  pos_divide_less_eq [of "numeral w", OF zero_less_numeral]
+  neg_divide_less_eq [of "neg_numeral w", OF neg_numeral_less_zero] for w
+
+lemmas eq_divide_eq_numeral1 [simp] =
+  eq_divide_eq [of _ _ "numeral w"]
+  eq_divide_eq [of _ _ "neg_numeral w"] for w
+
+lemmas divide_eq_eq_numeral1 [simp] =
+  divide_eq_eq [of _ "numeral w"]
+  divide_eq_eq [of _ "neg_numeral w"] for w
 
 subsubsection{*Optional Simplification Rules Involving Constants*}
 
 text{*Simplify quotients that are compared with a literal constant.*}
 
-lemmas le_divide_eq_number_of = le_divide_eq [of "number_of w"] for w
-lemmas divide_le_eq_number_of = divide_le_eq [of _ _ "number_of w"] for w
-lemmas less_divide_eq_number_of = less_divide_eq [of "number_of w"] for w
-lemmas divide_less_eq_number_of = divide_less_eq [of _ _ "number_of w"] for w
-lemmas eq_divide_eq_number_of = eq_divide_eq [of "number_of w"] for w
-lemmas divide_eq_eq_number_of = divide_eq_eq [of _ _ "number_of w"] for w
+lemmas le_divide_eq_numeral =
+  le_divide_eq [of "numeral w"]
+  le_divide_eq [of "neg_numeral w"] for w
+
+lemmas divide_le_eq_numeral =
+  divide_le_eq [of _ _ "numeral w"]
+  divide_le_eq [of _ _ "neg_numeral w"] for w
+
+lemmas less_divide_eq_numeral =
+  less_divide_eq [of "numeral w"]
+  less_divide_eq [of "neg_numeral w"] for w
+
+lemmas divide_less_eq_numeral =
+  divide_less_eq [of _ _ "numeral w"]
+  divide_less_eq [of _ _ "neg_numeral w"] for w
+
+lemmas eq_divide_eq_numeral =
+  eq_divide_eq [of "numeral w"]
+  eq_divide_eq [of "neg_numeral w"] for w
+
+lemmas divide_eq_eq_numeral =
+  divide_eq_eq [of _ _ "numeral w"]
+  divide_eq_eq [of _ _ "neg_numeral w"] for w
 
 
 text{*Not good as automatic simprules because they cause case splits.*}
 lemmas divide_const_simps =
-  le_divide_eq_number_of divide_le_eq_number_of less_divide_eq_number_of
-  divide_less_eq_number_of eq_divide_eq_number_of divide_eq_eq_number_of
+  le_divide_eq_numeral divide_le_eq_numeral less_divide_eq_numeral
+  divide_less_eq_numeral eq_divide_eq_numeral divide_eq_eq_numeral
   le_divide_eq_1 divide_le_eq_1 less_divide_eq_1 divide_less_eq_1
 
 text{*Division By @{text "-1"}*}
 
-lemma divide_minus1 [simp]:
-     "x/-1 = -(x::'a::{field_inverse_zero, number_ring})"
-by simp
+lemma divide_minus1 [simp]: "(x::'a::field) / -1 = - x"
+  unfolding minus_one [symmetric]
+  unfolding nonzero_minus_divide_right [OF one_neq_zero, symmetric]
+  by simp
 
-lemma minus1_divide [simp]:
-     "-1 / (x::'a::{field_inverse_zero, number_ring}) = - (1/x)"
-by (simp add: divide_inverse)
+lemma minus1_divide [simp]: "-1 / (x::'a::field) = - (1 / x)"
+  unfolding minus_one [symmetric] by (rule divide_minus_left)
 
 lemma half_gt_zero_iff:
-     "(0 < r/2) = (0 < (r::'a::{linordered_field_inverse_zero,number_ring}))"
+     "(0 < r/2) = (0 < (r::'a::linordered_field_inverse_zero))"
 by auto
 
 lemmas half_gt_zero [simp] = half_gt_zero_iff [THEN iffD2]
 
-lemma divide_Numeral1:
-  "(x::'a::{field, number_ring}) / Numeral1 = x"
-  by simp
-
-lemma divide_Numeral0:
-  "(x::'a::{field_inverse_zero, number_ring}) / Numeral0 = 0"
+lemma divide_Numeral1: "(x::'a::field) / Numeral1 = x"
   by simp
 
 
@@ -2211,128 +1559,154 @@
 
 subsection {* Configuration of the code generator *}
 
-code_datatype Pls Min Bit0 Bit1 "number_of \<Colon> int \<Rightarrow> int"
+text {* Constructors *}
+
+definition Pos :: "num \<Rightarrow> int" where
+  [simp, code_abbrev]: "Pos = numeral"
+
+definition Neg :: "num \<Rightarrow> int" where
+  [simp, code_abbrev]: "Neg = neg_numeral"
+
+code_datatype "0::int" Pos Neg
+
+
+text {* Auxiliary operations *}
+
+definition dup :: "int \<Rightarrow> int" where
+  [simp]: "dup k = k + k"
 
-lemmas pred_succ_numeral_code [code] =
-  pred_bin_simps succ_bin_simps
+lemma dup_code [code]:
+  "dup 0 = 0"
+  "dup (Pos n) = Pos (Num.Bit0 n)"
+  "dup (Neg n) = Neg (Num.Bit0 n)"
+  unfolding Pos_def Neg_def neg_numeral_def
+  by (simp_all add: numeral_Bit0)
+
+definition sub :: "num \<Rightarrow> num \<Rightarrow> int" where
+  [simp]: "sub m n = numeral m - numeral n"
 
-lemmas plus_numeral_code [code] =
-  add_bin_simps
-  arith_extra_simps(1) [where 'a = int]
+lemma sub_code [code]:
+  "sub Num.One Num.One = 0"
+  "sub (Num.Bit0 m) Num.One = Pos (Num.BitM m)"
+  "sub (Num.Bit1 m) Num.One = Pos (Num.Bit0 m)"
+  "sub Num.One (Num.Bit0 n) = Neg (Num.BitM n)"
+  "sub Num.One (Num.Bit1 n) = Neg (Num.Bit0 n)"
+  "sub (Num.Bit0 m) (Num.Bit0 n) = dup (sub m n)"
+  "sub (Num.Bit1 m) (Num.Bit1 n) = dup (sub m n)"
+  "sub (Num.Bit1 m) (Num.Bit0 n) = dup (sub m n) + 1"
+  "sub (Num.Bit0 m) (Num.Bit1 n) = dup (sub m n) - 1"
+  unfolding sub_def dup_def numeral.simps Pos_def Neg_def
+    neg_numeral_def numeral_BitM
+  by (simp_all only: algebra_simps)
 
-lemmas minus_numeral_code [code] =
-  minus_bin_simps
-  arith_extra_simps(2) [where 'a = int]
-  arith_extra_simps(5) [where 'a = int]
+
+text {* Implementations *}
+
+lemma one_int_code [code, code_unfold]:
+  "1 = Pos Num.One"
+  by simp
+
+lemma plus_int_code [code]:
+  "k + 0 = (k::int)"
+  "0 + l = (l::int)"
+  "Pos m + Pos n = Pos (m + n)"
+  "Pos m + Neg n = sub m n"
+  "Neg m + Pos n = sub n m"
+  "Neg m + Neg n = Neg (m + n)"
+  by simp_all
 
-lemmas times_numeral_code [code] =
-  mult_bin_simps
-  arith_extra_simps(4) [where 'a = int]
+lemma uminus_int_code [code]:
+  "uminus 0 = (0::int)"
+  "uminus (Pos m) = Neg m"
+  "uminus (Neg m) = Pos m"
+  by simp_all
+
+lemma minus_int_code [code]:
+  "k - 0 = (k::int)"
+  "0 - l = uminus (l::int)"
+  "Pos m - Pos n = sub m n"
+  "Pos m - Neg n = Pos (m + n)"
+  "Neg m - Pos n = Neg (m + n)"
+  "Neg m - Neg n = sub n m"
+  by simp_all
+
+lemma times_int_code [code]:
+  "k * 0 = (0::int)"
+  "0 * l = (0::int)"
+  "Pos m * Pos n = Pos (m * n)"
+  "Pos m * Neg n = Neg (m * n)"
+  "Neg m * Pos n = Neg (m * n)"
+  "Neg m * Neg n = Pos (m * n)"
+  by simp_all
 
 instantiation int :: equal
 begin
 
 definition
-  "HOL.equal k l \<longleftrightarrow> k - l = (0\<Colon>int)"
+  "HOL.equal k l \<longleftrightarrow> k = (l::int)"
 
-instance by default (simp add: equal_int_def)
+instance by default (rule equal_int_def)
 
 end
 
-lemma eq_number_of_int_code [code]:
-  "HOL.equal (number_of k \<Colon> int) (number_of l) \<longleftrightarrow> HOL.equal k l"
-  unfolding equal_int_def number_of_is_id ..
+lemma equal_int_code [code]:
+  "HOL.equal 0 (0::int) \<longleftrightarrow> True"
+  "HOL.equal 0 (Pos l) \<longleftrightarrow> False"
+  "HOL.equal 0 (Neg l) \<longleftrightarrow> False"
+  "HOL.equal (Pos k) 0 \<longleftrightarrow> False"
+  "HOL.equal (Pos k) (Pos l) \<longleftrightarrow> HOL.equal k l"
+  "HOL.equal (Pos k) (Neg l) \<longleftrightarrow> False"
+  "HOL.equal (Neg k) 0 \<longleftrightarrow> False"
+  "HOL.equal (Neg k) (Pos l) \<longleftrightarrow> False"
+  "HOL.equal (Neg k) (Neg l) \<longleftrightarrow> HOL.equal k l"
+  by (auto simp add: equal)
 
-lemma eq_int_code [code]:
-  "HOL.equal Int.Pls Int.Pls \<longleftrightarrow> True"
-  "HOL.equal Int.Pls Int.Min \<longleftrightarrow> False"
-  "HOL.equal Int.Pls (Int.Bit0 k2) \<longleftrightarrow> HOL.equal Int.Pls k2"
-  "HOL.equal Int.Pls (Int.Bit1 k2) \<longleftrightarrow> False"
-  "HOL.equal Int.Min Int.Pls \<longleftrightarrow> False"
-  "HOL.equal Int.Min Int.Min \<longleftrightarrow> True"
-  "HOL.equal Int.Min (Int.Bit0 k2) \<longleftrightarrow> False"
-  "HOL.equal Int.Min (Int.Bit1 k2) \<longleftrightarrow> HOL.equal Int.Min k2"
-  "HOL.equal (Int.Bit0 k1) Int.Pls \<longleftrightarrow> HOL.equal k1 Int.Pls"
-  "HOL.equal (Int.Bit1 k1) Int.Pls \<longleftrightarrow> False"
-  "HOL.equal (Int.Bit0 k1) Int.Min \<longleftrightarrow> False"
-  "HOL.equal (Int.Bit1 k1) Int.Min \<longleftrightarrow> HOL.equal k1 Int.Min"
-  "HOL.equal (Int.Bit0 k1) (Int.Bit0 k2) \<longleftrightarrow> HOL.equal k1 k2"
-  "HOL.equal (Int.Bit0 k1) (Int.Bit1 k2) \<longleftrightarrow> False"
-  "HOL.equal (Int.Bit1 k1) (Int.Bit0 k2) \<longleftrightarrow> False"
-  "HOL.equal (Int.Bit1 k1) (Int.Bit1 k2) \<longleftrightarrow> HOL.equal k1 k2"
-  unfolding equal_eq by simp_all
-
-lemma eq_int_refl [code nbe]:
+lemma equal_int_refl [code nbe]:
   "HOL.equal (k::int) k \<longleftrightarrow> True"
-  by (rule equal_refl)
-
-lemma less_eq_number_of_int_code [code]:
-  "(number_of k \<Colon> int) \<le> number_of l \<longleftrightarrow> k \<le> l"
-  unfolding number_of_is_id ..
+  by (fact equal_refl)
 
 lemma less_eq_int_code [code]:
-  "Int.Pls \<le> Int.Pls \<longleftrightarrow> True"
-  "Int.Pls \<le> Int.Min \<longleftrightarrow> False"
-  "Int.Pls \<le> Int.Bit0 k \<longleftrightarrow> Int.Pls \<le> k"
-  "Int.Pls \<le> Int.Bit1 k \<longleftrightarrow> Int.Pls \<le> k"
-  "Int.Min \<le> Int.Pls \<longleftrightarrow> True"
-  "Int.Min \<le> Int.Min \<longleftrightarrow> True"
-  "Int.Min \<le> Int.Bit0 k \<longleftrightarrow> Int.Min < k"
-  "Int.Min \<le> Int.Bit1 k \<longleftrightarrow> Int.Min \<le> k"
-  "Int.Bit0 k \<le> Int.Pls \<longleftrightarrow> k \<le> Int.Pls"
-  "Int.Bit1 k \<le> Int.Pls \<longleftrightarrow> k < Int.Pls"
-  "Int.Bit0 k \<le> Int.Min \<longleftrightarrow> k \<le> Int.Min"
-  "Int.Bit1 k \<le> Int.Min \<longleftrightarrow> k \<le> Int.Min"
-  "Int.Bit0 k1 \<le> Int.Bit0 k2 \<longleftrightarrow> k1 \<le> k2"
-  "Int.Bit0 k1 \<le> Int.Bit1 k2 \<longleftrightarrow> k1 \<le> k2"
-  "Int.Bit1 k1 \<le> Int.Bit0 k2 \<longleftrightarrow> k1 < k2"
-  "Int.Bit1 k1 \<le> Int.Bit1 k2 \<longleftrightarrow> k1 \<le> k2"
+  "0 \<le> (0::int) \<longleftrightarrow> True"
+  "0 \<le> Pos l \<longleftrightarrow> True"
+  "0 \<le> Neg l \<longleftrightarrow> False"
+  "Pos k \<le> 0 \<longleftrightarrow> False"
+  "Pos k \<le> Pos l \<longleftrightarrow> k \<le> l"
+  "Pos k \<le> Neg l \<longleftrightarrow> False"
+  "Neg k \<le> 0 \<longleftrightarrow> True"
+  "Neg k \<le> Pos l \<longleftrightarrow> True"
+  "Neg k \<le> Neg l \<longleftrightarrow> l \<le> k"
   by simp_all
 
-lemma less_number_of_int_code [code]:
-  "(number_of k \<Colon> int) < number_of l \<longleftrightarrow> k < l"
-  unfolding number_of_is_id ..
-
 lemma less_int_code [code]:
-  "Int.Pls < Int.Pls \<longleftrightarrow> False"
-  "Int.Pls < Int.Min \<longleftrightarrow> False"
-  "Int.Pls < Int.Bit0 k \<longleftrightarrow> Int.Pls < k"
-  "Int.Pls < Int.Bit1 k \<longleftrightarrow> Int.Pls \<le> k"
-  "Int.Min < Int.Pls \<longleftrightarrow> True"
-  "Int.Min < Int.Min \<longleftrightarrow> False"
-  "Int.Min < Int.Bit0 k \<longleftrightarrow> Int.Min < k"
-  "Int.Min < Int.Bit1 k \<longleftrightarrow> Int.Min < k"
-  "Int.Bit0 k < Int.Pls \<longleftrightarrow> k < Int.Pls"
-  "Int.Bit1 k < Int.Pls \<longleftrightarrow> k < Int.Pls"
-  "Int.Bit0 k < Int.Min \<longleftrightarrow> k \<le> Int.Min"
-  "Int.Bit1 k < Int.Min \<longleftrightarrow> k < Int.Min"
-  "Int.Bit0 k1 < Int.Bit0 k2 \<longleftrightarrow> k1 < k2"
-  "Int.Bit0 k1 < Int.Bit1 k2 \<longleftrightarrow> k1 \<le> k2"
-  "Int.Bit1 k1 < Int.Bit0 k2 \<longleftrightarrow> k1 < k2"
-  "Int.Bit1 k1 < Int.Bit1 k2 \<longleftrightarrow> k1 < k2"
+  "0 < (0::int) \<longleftrightarrow> False"
+  "0 < Pos l \<longleftrightarrow> True"
+  "0 < Neg l \<longleftrightarrow> False"
+  "Pos k < 0 \<longleftrightarrow> False"
+  "Pos k < Pos l \<longleftrightarrow> k < l"
+  "Pos k < Neg l \<longleftrightarrow> False"
+  "Neg k < 0 \<longleftrightarrow> True"
+  "Neg k < Pos l \<longleftrightarrow> True"
+  "Neg k < Neg l \<longleftrightarrow> l < k"
   by simp_all
 
-definition
-  nat_aux :: "int \<Rightarrow> nat \<Rightarrow> nat" where
-  "nat_aux i n = nat i + n"
-
-lemma [code]:
-  "nat_aux i n = (if i \<le> 0 then n else nat_aux (i - 1) (Suc n))"  -- {* tail recursive *}
-  by (auto simp add: nat_aux_def nat_eq_iff linorder_not_le order_less_imp_le
-    dest: zless_imp_add1_zle)
+lemma nat_numeral [simp, code_abbrev]:
+  "nat (numeral k) = numeral k"
+  by (simp add: nat_eq_iff)
 
-lemma [code]: "nat i = nat_aux i 0"
-  by (simp add: nat_aux_def)
-
-hide_const (open) nat_aux
+lemma nat_code [code]:
+  "nat (Int.Neg k) = 0"
+  "nat 0 = 0"
+  "nat (Int.Pos k) = nat_of_num k"
+  by (simp_all add: nat_of_num_numeral nat_numeral)
 
-lemma zero_is_num_zero [code, code_unfold]:
-  "(0\<Colon>int) = Numeral0" 
-  by simp
+lemma (in ring_1) of_int_code [code]:
+  "of_int (Int.Neg k) = neg_numeral k"
+  "of_int 0 = 0"
+  "of_int (Int.Pos k) = numeral k"
+  by simp_all
 
-lemma one_is_num_one [code, code_unfold]:
-  "(1\<Colon>int) = Numeral1" 
-  by simp
+
+text {* Serializer setup *}
 
 code_modulename SML
   Int Arith
@@ -2345,7 +1719,7 @@
 
 quickcheck_params [default_type = int]
 
-hide_const (open) Pls Min Bit0 Bit1 succ pred
+hide_const (open) Pos Neg sub dup
 
 
 subsection {* Legacy theorems *}
@@ -2378,3 +1752,4 @@
 lemmas zpower_int = int_power [symmetric]
 
 end
+
--- a/src/HOL/IsaMakefile	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/IsaMakefile	Sun Mar 25 20:15:39 2012 +0200
@@ -195,6 +195,7 @@
   Meson.thy \
   Metis.thy \
   Nat.thy \
+  Num.thy \
   Option.thy \
   Orderings.thy \
   Partial_Function.thy \
@@ -341,7 +342,6 @@
   Tools/Nitpick/nitpick_util.ML \
   Tools/numeral.ML \
   Tools/numeral_simprocs.ML \
-  Tools/numeral_syntax.ML \
   Tools/Predicate_Compile/core_data.ML \
   Tools/Predicate_Compile/mode_inference.ML \
   Tools/Predicate_Compile/predicate_compile_aux.ML \
@@ -444,24 +444,25 @@
   Library/Bit.thy Library/Boolean_Algebra.thy Library/Cardinality.thy	\
   Library/Char_nat.thy Library/Code_Char.thy Library/Code_Char_chr.thy	\
   Library/Code_Char_ord.thy Library/Code_Integer.thy			\
-  Library/Code_Natural.thy Library/Code_Prolog.thy			\
+  Library/Code_Nat.thy Library/Code_Natural.thy				\
+  Library/Efficient_Nat.thy Library/Code_Prolog.thy			\
   Library/Code_Real_Approx_By_Float.thy					\
   Tools/Predicate_Compile/code_prolog.ML Library/ContNotDenum.thy	\
   Library/Cset.thy Library/Cset_Monad.thy Library/Continuity.thy	\
   Library/Convex.thy Library/Countable.thy				\
+  Library/Dlist.thy Library/Dlist_Cset.thy Library/Eval_Witness.thy	\
   Library/DAList.thy Library/Dlist.thy Library/Dlist_Cset.thy 		\
-  Library/Efficient_Nat.thy Library/Eval_Witness.thy			\
+  Library/Eval_Witness.thy						\
   Library/Extended_Real.thy Library/Extended_Nat.thy Library/Float.thy	\
   Library/Formal_Power_Series.thy Library/Fraction_Field.thy		\
   Library/FrechetDeriv.thy Library/Cset.thy Library/FuncSet.thy		\
-  Library/Function_Algebras.thy						\
-  Library/Fundamental_Theorem_Algebra.thy Library/Glbs.thy		\
-  Library/Indicator_Function.thy Library/Infinite_Set.thy		\
-  Library/Inner_Product.thy Library/Kleene_Algebra.thy			\
-  Library/LaTeXsugar.thy Library/Lattice_Algebras.thy			\
-  Library/Lattice_Syntax.thy Library/Library.thy Library/List_Cset.thy	\
-  Library/List_Prefix.thy Library/List_lexord.thy Library/Mapping.thy	\
-  Library/Monad_Syntax.thy						\
+  Library/Function_Algebras.thy Library/Fundamental_Theorem_Algebra.thy	\
+  Library/Glbs.thy Library/Indicator_Function.thy			\
+  Library/Infinite_Set.thy Library/Inner_Product.thy			\
+  Library/Kleene_Algebra.thy Library/LaTeXsugar.thy			\
+  Library/Lattice_Algebras.thy Library/Lattice_Syntax.thy		\
+  Library/Library.thy Library/List_Cset.thy Library/List_Prefix.thy	\
+  Library/List_lexord.thy Library/Mapping.thy Library/Monad_Syntax.thy	\
   Library/Multiset.thy Library/Nat_Bijection.thy			\
   Library/Numeral_Type.thy Library/Old_Recdef.thy			\
   Library/OptionalSugar.thy Library/Order_Relation.thy			\
@@ -479,7 +480,7 @@
   Library/State_Monad.thy Library/Ramsey.thy				\
   Library/Reflection.thy Library/Sublist_Order.thy			\
   Library/Sum_of_Squares.thy Library/Sum_of_Squares/sos_wrapper.ML	\
-  Library/Sum_of_Squares/sum_of_squares.ML				\
+  Library/Sum_of_Squares/sum_of_squares.ML Library/Target_Numeral.thy	\
   Library/Transitive_Closure_Table.thy Library/Univ_Poly.thy		\
   Library/Wfrec.thy Library/While_Combinator.thy Library/Zorn.thy	\
   $(SRC)/Tools/adhoc_overloading.ML Library/positivstellensatz.ML	\
@@ -758,11 +759,11 @@
 
 HOL-Library-Codegenerator_Test: HOL-Library $(LOG)/HOL-Library-Codegenerator_Test.gz
 
-$(LOG)/HOL-Library-Codegenerator_Test.gz: $(OUT)/HOL-Library		\
-  Codegenerator_Test/ROOT.ML 						\
-  Codegenerator_Test/Candidates.thy					\
-  Codegenerator_Test/Candidates_Pretty.thy				\
-  Codegenerator_Test/Generate.thy					\
+$(LOG)/HOL-Library-Codegenerator_Test.gz: $(OUT)/HOL-Library \
+  Codegenerator_Test/ROOT.ML \
+  Codegenerator_Test/Candidates.thy \
+  Codegenerator_Test/Candidates_Pretty.thy \
+  Codegenerator_Test/Generate.thy \
   Codegenerator_Test/Generate_Pretty.thy
 	@$(ISABELLE_TOOL) usedir -d false -g false -i false $(OUT)/HOL-Library Codegenerator_Test
 
@@ -920,6 +921,10 @@
 HOL-Imperative_HOL: HOL $(LOG)/HOL-Imperative_HOL.gz
 
 $(LOG)/HOL-Imperative_HOL.gz: $(OUT)/HOL \
+  Library/Code_Integer.thy \
+  Library/Code_Nat.thy \
+  Library/Code_Natural.thy \
+  Library/Efficient_Nat.thy \
   Imperative_HOL/Array.thy \
   Imperative_HOL/Heap.thy \
   Imperative_HOL/Heap_Monad.thy \
@@ -943,6 +948,10 @@
 HOL-Decision_Procs: HOL $(LOG)/HOL-Decision_Procs.gz
 
 $(LOG)/HOL-Decision_Procs.gz: $(OUT)/HOL \
+  Library/Code_Integer.thy \
+  Library/Code_Nat.thy \
+  Library/Code_Natural.thy \
+  Library/Efficient_Nat.thy \
   Decision_Procs/Approximation.thy \
   Decision_Procs/Commutative_Ring.thy \
   Decision_Procs/Commutative_Ring_Complete.thy \
@@ -991,9 +1000,12 @@
 HOL-Proofs-Extraction: HOL-Proofs $(LOG)/HOL-Proofs-Extraction.gz
 
 $(LOG)/HOL-Proofs-Extraction.gz: $(OUT)/HOL-Proofs		\
-  Library/Efficient_Nat.thy Proofs/Extraction/Euclid.thy	\
+  Library/Code_Integer.thy Library/Code_Nat.thy			\
+  Library/Code_Natural.thy Library/Efficient_Nat.thy		\
+  Proofs/Extraction/Euclid.thy					\
   Proofs/Extraction/Greatest_Common_Divisor.thy			\
-  Proofs/Extraction/Higman.thy Proofs/Extraction/Higman_Extraction.thy	\
+  Proofs/Extraction/Higman.thy					\
+  Proofs/Extraction/Higman_Extraction.thy			\
   Proofs/Extraction/Pigeonhole.thy				\
   Proofs/Extraction/QuotRem.thy Proofs/Extraction/ROOT.ML	\
   Proofs/Extraction/Util.thy Proofs/Extraction/Warshall.thy	\
@@ -1113,15 +1125,17 @@
 HOL-ex: HOL $(LOG)/HOL-ex.gz
 
 $(LOG)/HOL-ex.gz: $(OUT)/HOL Decision_Procs/Commutative_Ring.thy	\
+  Library/Code_Integer.thy Library/Code_Nat.thy				\
+  Library/Code_Natural.thy Library/Efficient_Nat.thy			\
   Number_Theory/Primes.thy ex/Abstract_NAT.thy ex/Antiquote.thy		\
   ex/Arith_Examples.thy ex/Arithmetic_Series_Complex.thy ex/BT.thy	\
   ex/BinEx.thy ex/Binary.thy ex/Birthday_Paradox.thy ex/CTL.thy		\
   ex/Case_Product.thy ex/Chinese.thy ex/Classical.thy			\
-  ex/Coercion_Examples.thy ex/Coherent.thy				\
-  ex/Dedekind_Real.thy ex/Efficient_Nat_examples.thy			\
+  ex/Code_Nat_examples.thy						\
+  ex/Coercion_Examples.thy ex/Coherent.thy ex/Dedekind_Real.thy		\
   ex/Eval_Examples.thy ex/Executable_Relation.thy ex/Fundefs.thy	\
   ex/Gauge_Integration.thy ex/Groebner_Examples.thy ex/Guess.thy	\
-  ex/HarmonicSeries.thy ex/Hebrew.thy ex/Hex_Bin_Examples.thy 		\
+  ex/HarmonicSeries.thy ex/Hebrew.thy ex/Hex_Bin_Examples.thy		\
   ex/Higher_Order_Logic.thy ex/Iff_Oracle.thy ex/Induction_Schema.thy	\
   ex/Interpretation_with_Defs.thy ex/Intuitionistic.thy			\
   ex/Lagrange.thy ex/List_to_Set_Comprehension_Examples.thy		\
--- a/src/HOL/Library/BigO.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/BigO.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -132,7 +132,6 @@
   apply (simp add: abs_triangle_ineq)
   apply (simp add: order_less_le)
   apply (rule mult_nonneg_nonneg)
-  apply (rule add_nonneg_nonneg)
   apply auto
   apply (rule_tac x = "%n. if (abs (f n)) <  abs (g n) then x n else 0" 
      in exI)
@@ -150,11 +149,8 @@
   apply (rule abs_triangle_ineq)
   apply (simp add: order_less_le)
   apply (rule mult_nonneg_nonneg)
-  apply (rule add_nonneg_nonneg)
-  apply (erule order_less_imp_le)+
+  apply (erule order_less_imp_le)
   apply simp
-  apply (rule ext)
-  apply (auto simp add: if_splits linorder_not_le)
   done
 
 lemma bigo_plus_subset2 [intro]: "A <= O(f) ==> B <= O(f) ==> A \<oplus> B <= O(f)"
--- a/src/HOL/Library/Binomial.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/Binomial.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -350,7 +350,7 @@
     have eq: "(- (1\<Colon>'a)) ^ n = setprod (\<lambda>i. - 1) {0 .. n - 1}"
       by auto
     from n0 have ?thesis 
-      by (simp add: pochhammer_def gbinomial_def field_simps eq setprod_timesf[symmetric])}
+      by (simp add: pochhammer_def gbinomial_def field_simps eq setprod_timesf[symmetric] del: minus_one) (* FIXME: del: minus_one *)}
   ultimately show ?thesis by blast
 qed
 
@@ -417,8 +417,8 @@
     from eq[symmetric]
     have ?thesis using kn
       apply (simp add: binomial_fact[OF kn, where ?'a = 'a] 
-        gbinomial_pochhammer field_simps pochhammer_Suc_setprod)
-      apply (simp add: pochhammer_Suc_setprod fact_altdef_nat h of_nat_setprod setprod_timesf[symmetric] eq' del: One_nat_def power_Suc)
+        gbinomial_pochhammer field_simps pochhammer_Suc_setprod del: minus_one)
+      apply (simp add: pochhammer_Suc_setprod fact_altdef_nat h of_nat_setprod setprod_timesf[symmetric] eq' del: One_nat_def power_Suc del: minus_one)
       unfolding setprod_Un_disjoint[OF th0, unfolded eq3, of "of_nat:: nat \<Rightarrow> 'a"] eq[unfolded h]
       unfolding mult_assoc[symmetric] 
       unfolding setprod_timesf[symmetric]
--- a/src/HOL/Library/Bit.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/Bit.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -96,27 +96,18 @@
 
 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)
+  by (simp only: minus_one [symmetric] uminus_bit_def)
+
+lemma bit_neg_numeral [simp]: "(neg_numeral w :: bit) = numeral w"
+  by (simp only: neg_numeral_def 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_numeral_even [simp]: "numeral (Num.Bit0 w) = (0 :: bit)"
+  by (simp only: numeral_Bit0 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)
+lemma bit_numeral_odd [simp]: "numeral (Num.Bit1 w) = (1 :: bit)"
+  by (simp only: numeral_Bit1 bit_add_self add_0_left)
 
 end
--- a/src/HOL/Library/Cardinality.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/Cardinality.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -5,7 +5,7 @@
 header {* Cardinality of types *}
 
 theory Cardinality
-imports Main
+imports "~~/src/HOL/Main"
 begin
 
 subsection {* Preliminary lemmas *}
--- a/src/HOL/Library/Code_Integer.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/Code_Integer.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -9,6 +9,43 @@
 begin
 
 text {*
+  Representation-ignorant code equations for conversions.
+*}
+
+lemma nat_code [code]:
+  "nat k = (if k \<le> 0 then 0 else
+     let
+       (l, j) = divmod_int k 2;
+       l' = 2 * nat l
+     in if j = 0 then l' else Suc l')"
+proof -
+  have "2 = nat 2" by simp
+  show ?thesis
+    apply (auto simp add: Let_def divmod_int_mod_div not_le
+     nat_div_distrib nat_mult_distrib mult_div_cancel mod_2_not_eq_zero_eq_one_int)
+    apply (unfold `2 = nat 2`)
+    apply (subst nat_mod_distrib [symmetric])
+    apply simp_all
+  done
+qed
+
+lemma (in ring_1) of_int_code:
+  "of_int k = (if k = 0 then 0
+     else if k < 0 then - of_int (- k)
+     else let
+       (l, j) = divmod_int k 2;
+       l' = 2 * of_int l
+     in if j = 0 then l' else l' + 1)"
+proof -
+  from mod_div_equality have *: "of_int k = of_int (k div 2 * 2 + k mod 2)" by simp
+  show ?thesis
+    by (simp add: Let_def divmod_int_mod_div mod_2_not_eq_zero_eq_one_int
+      of_int_add [symmetric]) (simp add: * mult_commute)
+qed
+
+declare of_int_code [code]
+
+text {*
   HOL numeral expressions are mapped to integer literals
   in target languages, using predefined target language
   operations for abstract integer operations.
@@ -24,42 +61,21 @@
 code_instance int :: equal
   (Haskell -)
 
+code_const "0::int"
+  (SML "0")
+  (OCaml "Big'_int.zero'_big'_int")
+  (Haskell "0")
+  (Scala "BigInt(0)")
+
 setup {*
-  fold (Numeral.add_code @{const_name number_int_inst.number_of_int}
-    true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
+  fold (Numeral.add_code @{const_name Int.Pos}
+    false Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
 *}
 
-code_const "Int.Pls" and "Int.Min" and "Int.Bit0" and "Int.Bit1"
-  (SML "raise/ Fail/ \"Pls\""
-     and "raise/ Fail/ \"Min\""
-     and "!((_);/ raise/ Fail/ \"Bit0\")"
-     and "!((_);/ raise/ Fail/ \"Bit1\")")
-  (OCaml "failwith/ \"Pls\""
-     and "failwith/ \"Min\""
-     and "!((_);/ failwith/ \"Bit0\")"
-     and "!((_);/ failwith/ \"Bit1\")")
-  (Haskell "error/ \"Pls\""
-     and "error/ \"Min\""
-     and "error/ \"Bit0\""
-     and "error/ \"Bit1\"")
-  (Scala "!error(\"Pls\")"
-     and "!error(\"Min\")"
-     and "!error(\"Bit0\")"
-     and "!error(\"Bit1\")")
-
-code_const Int.pred
-  (SML "IntInf.- ((_), 1)")
-  (OCaml "Big'_int.pred'_big'_int")
-  (Haskell "!(_/ -/ 1)")
-  (Scala "!(_ -/ 1)")
-  (Eval "!(_/ -/ 1)")
-
-code_const Int.succ
-  (SML "IntInf.+ ((_), 1)")
-  (OCaml "Big'_int.succ'_big'_int")
-  (Haskell "!(_/ +/ 1)")
-  (Scala "!(_ +/ 1)")
-  (Eval "!(_/ +/ 1)")
+setup {*
+  fold (Numeral.add_code @{const_name Int.Neg}
+    true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
+*}
 
 code_const "op + \<Colon> int \<Rightarrow> int \<Rightarrow> int"
   (SML "IntInf.+ ((_), (_))")
@@ -82,6 +98,19 @@
   (Scala infixl 7 "-")
   (Eval infixl 8 "-")
 
+code_const Int.dup
+  (SML "IntInf.*/ (2,/ (_))")
+  (OCaml "Big'_int.mult'_big'_int/ 2")
+  (Haskell "!(2 * _)")
+  (Scala "!(2 * _)")
+  (Eval "!(2 * _)")
+
+code_const Int.sub
+  (SML "!(raise/ Fail/ \"sub\")")
+  (OCaml "failwith/ \"sub\"")
+  (Haskell "error/ \"sub\"")
+  (Scala "!error(\"sub\")")
+
 code_const "op * \<Colon> int \<Rightarrow> int \<Rightarrow> int"
   (SML "IntInf.* ((_), (_))")
   (OCaml "Big'_int.mult'_big'_int")
@@ -124,9 +153,7 @@
   (Scala "!_.as'_BigInt")
   (Eval "_")
 
-text {* Evaluation *}
-
 code_const "Code_Evaluation.term_of \<Colon> int \<Rightarrow> term"
   (Eval "HOLogic.mk'_number/ HOLogic.intT")
 
-end
\ No newline at end of file
+end
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Library/Code_Nat.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -0,0 +1,258 @@
+(*  Title:      HOL/Library/Code_Nat.thy
+    Author:     Stefan Berghofer, Florian Haftmann, TU Muenchen
+*)
+
+header {* Implementation of natural numbers as binary numerals *}
+
+theory Code_Nat
+imports Main
+begin
+
+text {*
+  When generating code for functions on natural numbers, the
+  canonical representation using @{term "0::nat"} and
+  @{term Suc} is unsuitable for computations involving large
+  numbers.  This theory refines the representation of
+  natural numbers for code generation to use binary
+  numerals, which do not grow linear in size but logarithmic.
+*}
+
+subsection {* Representation *}
+
+lemma [code_abbrev]:
+  "nat_of_num = numeral"
+  by (fact nat_of_num_numeral)
+
+code_datatype "0::nat" nat_of_num
+
+lemma [code]:
+  "num_of_nat 0 = Num.One"
+  "num_of_nat (nat_of_num k) = k"
+  by (simp_all add: nat_of_num_inverse)
+
+lemma [code]:
+  "(1\<Colon>nat) = Numeral1"
+  by simp
+
+lemma [code_abbrev]: "Numeral1 = (1\<Colon>nat)"
+  by simp
+
+lemma [code]:
+  "Suc n = n + 1"
+  by simp
+
+
+subsection {* Basic arithmetic *}
+
+lemma [code, code del]:
+  "(plus :: nat \<Rightarrow> _) = plus" ..
+
+lemma plus_nat_code [code]:
+  "nat_of_num k + nat_of_num l = nat_of_num (k + l)"
+  "m + 0 = (m::nat)"
+  "0 + n = (n::nat)"
+  by (simp_all add: nat_of_num_numeral)
+
+text {* Bounded subtraction needs some auxiliary *}
+
+definition dup :: "nat \<Rightarrow> nat" where
+  "dup n = n + n"
+
+lemma dup_code [code]:
+  "dup 0 = 0"
+  "dup (nat_of_num k) = nat_of_num (Num.Bit0 k)"
+  unfolding Num_def by (simp_all add: dup_def numeral_Bit0)
+
+definition sub :: "num \<Rightarrow> num \<Rightarrow> nat option" where
+  "sub k l = (if k \<ge> l then Some (numeral k - numeral l) else None)"
+
+lemma sub_code [code]:
+  "sub Num.One Num.One = Some 0"
+  "sub (Num.Bit0 m) Num.One = Some (nat_of_num (Num.BitM m))"
+  "sub (Num.Bit1 m) Num.One = Some (nat_of_num (Num.Bit0 m))"
+  "sub Num.One (Num.Bit0 n) = None"
+  "sub Num.One (Num.Bit1 n) = None"
+  "sub (Num.Bit0 m) (Num.Bit0 n) = Option.map dup (sub m n)"
+  "sub (Num.Bit1 m) (Num.Bit1 n) = Option.map dup (sub m n)"
+  "sub (Num.Bit1 m) (Num.Bit0 n) = Option.map (\<lambda>q. dup q + 1) (sub m n)"
+  "sub (Num.Bit0 m) (Num.Bit1 n) = (case sub m n of None \<Rightarrow> None
+     | Some q \<Rightarrow> if q = 0 then None else Some (dup q - 1))"
+  apply (auto simp add: nat_of_num_numeral
+    Num.dbl_def Num.dbl_inc_def Num.dbl_dec_def
+    Let_def le_imp_diff_is_add BitM_plus_one sub_def dup_def)
+  apply (simp_all add: sub_non_positive)
+  apply (simp_all add: sub_non_negative [symmetric, where ?'a = int])
+  done
+
+lemma [code, code del]:
+  "(minus :: nat \<Rightarrow> _) = minus" ..
+
+lemma minus_nat_code [code]:
+  "nat_of_num k - nat_of_num l = (case sub k l of None \<Rightarrow> 0 | Some j \<Rightarrow> j)"
+  "m - 0 = (m::nat)"
+  "0 - n = (0::nat)"
+  by (simp_all add: nat_of_num_numeral sub_non_positive sub_def)
+
+lemma [code, code del]:
+  "(times :: nat \<Rightarrow> _) = times" ..
+
+lemma times_nat_code [code]:
+  "nat_of_num k * nat_of_num l = nat_of_num (k * l)"
+  "m * 0 = (0::nat)"
+  "0 * n = (0::nat)"
+  by (simp_all add: nat_of_num_numeral)
+
+lemma [code, code del]:
+  "(HOL.equal :: nat \<Rightarrow> _) = HOL.equal" ..
+
+lemma equal_nat_code [code]:
+  "HOL.equal 0 (0::nat) \<longleftrightarrow> True"
+  "HOL.equal 0 (nat_of_num l) \<longleftrightarrow> False"
+  "HOL.equal (nat_of_num k) 0 \<longleftrightarrow> False"
+  "HOL.equal (nat_of_num k) (nat_of_num l) \<longleftrightarrow> HOL.equal k l"
+  by (simp_all add: nat_of_num_numeral equal)
+
+lemma equal_nat_refl [code nbe]:
+  "HOL.equal (n::nat) n \<longleftrightarrow> True"
+  by (rule equal_refl)
+
+lemma [code, code del]:
+  "(less_eq :: nat \<Rightarrow> _) = less_eq" ..
+
+lemma less_eq_nat_code [code]:
+  "0 \<le> (n::nat) \<longleftrightarrow> True"
+  "nat_of_num k \<le> 0 \<longleftrightarrow> False"
+  "nat_of_num k \<le> nat_of_num l \<longleftrightarrow> k \<le> l"
+  by (simp_all add: nat_of_num_numeral)
+
+lemma [code, code del]:
+  "(less :: nat \<Rightarrow> _) = less" ..
+
+lemma less_nat_code [code]:
+  "(m::nat) < 0 \<longleftrightarrow> False"
+  "0 < nat_of_num l \<longleftrightarrow> True"
+  "nat_of_num k < nat_of_num l \<longleftrightarrow> k < l"
+  by (simp_all add: nat_of_num_numeral)
+
+
+subsection {* Conversions *}
+
+lemma [code, code del]:
+  "of_nat = of_nat" ..
+
+lemma of_nat_code [code]:
+  "of_nat 0 = 0"
+  "of_nat (nat_of_num k) = numeral k"
+  by (simp_all add: nat_of_num_numeral)
+
+
+subsection {* Case analysis *}
+
+text {*
+  Case analysis on natural numbers is rephrased using a conditional
+  expression:
+*}
+
+lemma [code, code_unfold]:
+  "nat_case = (\<lambda>f g n. if n = 0 then f else g (n - 1))"
+  by (auto simp add: fun_eq_iff dest!: gr0_implies_Suc)
+
+
+subsection {* Preprocessors *}
+
+text {*
+  The term @{term "Suc n"} is no longer a valid pattern.
+  Therefore, all occurrences of this term in a position
+  where a pattern is expected (i.e.~on the left-hand side of a recursion
+  equation) must be eliminated.
+  This can be accomplished by applying the following transformation rules:
+*}
+
+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) (cases n, simp_all)
+
+text {*
+  The rules above are built into a preprocessor that is plugged into
+  the code generator. Since the preprocessor for introduction rules
+  does not know anything about modes, some of the modes that worked
+  for the canonical representation of natural numbers may no longer work.
+*}
+
+(*<*)
+setup {*
+let
+
+fun remove_suc thy thms =
+  let
+    val vname = singleton (Name.variant_list (map fst
+      (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 (cprop_of th))));
+    fun rhs_of th = snd (Thm.dest_comb (cprop_of th));
+    fun find_vars ct = (case term_of ct of
+        (Const (@{const_name Suc}, _) $ Var _) => [(cv, snd (Thm.dest_comb ct))]
+      | _ $ _ =>
+        let val (ct1, ct2) = Thm.dest_comb ct
+        in 
+          map (apfst (fn ct => Thm.apply ct ct2)) (find_vars ct1) @
+          map (apfst (Thm.apply ct1)) (find_vars ct2)
+        end
+      | _ => []);
+    val eqs = maps
+      (fn th => map (pair th) (find_vars (lhs_of th))) thms;
+    fun mk_thms (th, (ct, cv')) =
+      let
+        val th' =
+          Thm.implies_elim
+           (Conv.fconv_rule (Thm.beta_conversion true)
+             (Drule.instantiate'
+               [SOME (ctyp_of_term ct)] [SOME (Thm.lambda cv ct),
+                 SOME (Thm.lambda cv' (rhs_of th)), NONE, SOME cv']
+               @{thm Suc_if_eq})) (Thm.forall_intr cv' th)
+      in
+        case map_filter (fn th'' =>
+            SOME (th'', singleton
+              (Variable.trade (K (fn [th'''] => [th''' RS th']))
+                (Variable.global_thm_context th'')) th'')
+          handle THM _ => NONE) thms of
+            [] => NONE
+          | thps =>
+              let val (ths1, ths2) = split_list thps
+              in SOME (subtract Thm.eq_thm (th :: ths1) thms @ ths2) end
+      end
+  in get_first mk_thms eqs end;
+
+fun eqn_suc_base_preproc thy thms =
+  let
+    val dest = fst o Logic.dest_equals 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 thms |> perhaps_loop (remove_suc thy) |> (Option.map o map) Drule.zero_var_indexes
+       else NONE
+  end;
+
+val eqn_suc_preproc = Code_Preproc.simple_functrans eqn_suc_base_preproc;
+
+in
+
+  Code_Preproc.add_functrans ("eqn_Suc", eqn_suc_preproc)
+
+end;
+*}
+(*>*)
+
+code_modulename SML
+  Code_Nat Arith
+
+code_modulename OCaml
+  Code_Nat Arith
+
+code_modulename Haskell
+  Code_Nat Arith
+
+hide_const (open) dup sub
+
+end
--- a/src/HOL/Library/Code_Natural.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/Code_Natural.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -106,22 +106,26 @@
   (Scala "Natural")
 
 setup {*
-  fold (Numeral.add_code @{const_name number_code_numeral_inst.number_of_code_numeral}
+  fold (Numeral.add_code @{const_name Code_Numeral.Num}
     false Code_Printer.literal_alternative_numeral) ["Haskell", "Scala"]
 *}
 
 code_instance code_numeral :: equal
   (Haskell -)
 
-code_const "op + \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
+code_const "0::code_numeral"
+  (Haskell "0")
+  (Scala "Natural(0)")
+
+code_const "plus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   (Haskell infixl 6 "+")
   (Scala infixl 7 "+")
 
-code_const "op - \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
+code_const "minus \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   (Haskell infixl 6 "-")
   (Scala infixl 7 "-")
 
-code_const "op * \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
+code_const "times \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> code_numeral"
   (Haskell infixl 7 "*")
   (Scala infixl 8 "*")
 
@@ -133,11 +137,11 @@
   (Haskell infix 4 "==")
   (Scala infixl 5 "==")
 
-code_const "op \<le> \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
+code_const "less_eq \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   (Haskell infix 4 "<=")
   (Scala infixl 4 "<=")
 
-code_const "op < \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
+code_const "less \<Colon> code_numeral \<Rightarrow> code_numeral \<Rightarrow> bool"
   (Haskell infix 4 "<")
   (Scala infixl 4 "<")
 
--- a/src/HOL/Library/Code_Prolog.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/Code_Prolog.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -11,8 +11,10 @@
 
 section {* Setup for Numerals *}
 
-setup {* Predicate_Compile_Data.ignore_consts [@{const_name number_of}] *}
-setup {* Predicate_Compile_Data.keep_functions [@{const_name number_of}] *}
+setup {* Predicate_Compile_Data.ignore_consts
+  [@{const_name numeral}, @{const_name neg_numeral}] *}
+
+setup {* Predicate_Compile_Data.keep_functions
+  [@{const_name numeral}, @{const_name neg_numeral}] *}
 
 end
-
--- a/src/HOL/Library/Code_Real_Approx_By_Float.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/Code_Real_Approx_By_Float.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -129,9 +129,23 @@
 lemma of_int_eq_real_of_int[code_unfold]: "of_int = real_of_int"
   unfolding real_of_int_def ..
 
-hide_const (open) real_of_int
+lemma [code_unfold del]:
+  "0 \<equiv> (of_rat 0 :: real)"
+  by simp
+
+lemma [code_unfold del]:
+  "1 \<equiv> (of_rat 1 :: real)"
+  by simp
 
-declare number_of_real_code [code_unfold del]
+lemma [code_unfold del]:
+  "numeral k \<equiv> (of_rat (numeral k) :: real)"
+  by simp
+
+lemma [code_unfold del]:
+  "neg_numeral k \<equiv> (of_rat (neg_numeral k) :: real)"
+  by simp
+
+hide_const (open) real_of_int
 
 notepad
 begin
--- a/src/HOL/Library/Efficient_Nat.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/Efficient_Nat.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -5,175 +5,16 @@
 header {* Implementation of natural numbers by target-language integers *}
 
 theory Efficient_Nat
-imports Code_Integer Main
+imports Code_Nat Code_Integer Main
 begin
 
 text {*
-  When generating code for functions on natural numbers, the
-  canonical representation using @{term "0::nat"} and
-  @{term Suc} is unsuitable for computations involving large
-  numbers.  The efficiency of the generated code can be improved
+  The efficiency of the generated code for natural numbers can be improved
   drastically by implementing natural numbers by target-language
   integers.  To do this, just include this theory.
 *}
 
-subsection {* Basic arithmetic *}
-
-text {*
-  Most standard arithmetic functions on natural numbers are implemented
-  using their counterparts on the integers:
-*}
-
-code_datatype number_nat_inst.number_of_nat
-
-lemma zero_nat_code [code, code_unfold]:
-  "0 = (Numeral0 :: nat)"
-  by simp
-
-lemma one_nat_code [code, code_unfold]:
-  "1 = (Numeral1 :: nat)"
-  by simp
-
-lemma Suc_code [code]:
-  "Suc n = n + 1"
-  by simp
-
-lemma plus_nat_code [code]:
-  "n + m = nat (of_nat n + of_nat m)"
-  by simp
-
-lemma minus_nat_code [code]:
-  "n - m = nat (of_nat n - of_nat m)"
-  by simp
-
-lemma times_nat_code [code]:
-  "n * m = nat (of_nat n * of_nat m)"
-  unfolding of_nat_mult [symmetric] by simp
-
-lemma divmod_nat_code [code]:
-  "divmod_nat n m = map_pair nat nat (pdivmod (of_nat n) (of_nat m))"
-  by (simp add: map_pair_def split_def pdivmod_def nat_div_distrib nat_mod_distrib divmod_nat_div_mod)
-
-lemma eq_nat_code [code]:
-  "HOL.equal n m \<longleftrightarrow> HOL.equal (of_nat n \<Colon> int) (of_nat m)"
-  by (simp add: equal)
-
-lemma eq_nat_refl [code nbe]:
-  "HOL.equal (n::nat) n \<longleftrightarrow> True"
-  by (rule equal_refl)
-
-lemma less_eq_nat_code [code]:
-  "n \<le> m \<longleftrightarrow> (of_nat n \<Colon> int) \<le> of_nat m"
-  by simp
-
-lemma less_nat_code [code]:
-  "n < m \<longleftrightarrow> (of_nat n \<Colon> int) < of_nat m"
-  by simp
-
-subsection {* Case analysis *}
-
-text {*
-  Case analysis on natural numbers is rephrased using a conditional
-  expression:
-*}
-
-lemma [code, code_unfold]:
-  "nat_case = (\<lambda>f g n. if n = 0 then f else g (n - 1))"
-  by (auto simp add: fun_eq_iff dest!: gr0_implies_Suc)
-
-
-subsection {* Preprocessors *}
-
-text {*
-  In contrast to @{term "Suc n"}, the term @{term "n + (1::nat)"} is no longer
-  a constructor term. Therefore, all occurrences of this term in a position
-  where a pattern is expected (i.e.\ on the left-hand side of a recursion
-  equation or in the arguments of an inductive relation in an introduction
-  rule) must be eliminated.
-  This can be accomplished by applying the following transformation rules:
-*}
-
-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) (cases n, simp_all)
-
-lemma Suc_clause: "(\<And>n. P n (Suc n)) \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> P (n - 1) n"
-  by (cases n) simp_all
-
-text {*
-  The rules above are built into a preprocessor that is plugged into
-  the code generator. Since the preprocessor for introduction rules
-  does not know anything about modes, some of the modes that worked
-  for the canonical representation of natural numbers may no longer work.
-*}
-
-(*<*)
-setup {*
-let
-
-fun remove_suc thy thms =
-  let
-    val vname = singleton (Name.variant_list (map fst
-      (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 (cprop_of th))));
-    fun rhs_of th = snd (Thm.dest_comb (cprop_of th));
-    fun find_vars ct = (case term_of ct of
-        (Const (@{const_name Suc}, _) $ Var _) => [(cv, snd (Thm.dest_comb ct))]
-      | _ $ _ =>
-        let val (ct1, ct2) = Thm.dest_comb ct
-        in 
-          map (apfst (fn ct => Thm.apply ct ct2)) (find_vars ct1) @
-          map (apfst (Thm.apply ct1)) (find_vars ct2)
-        end
-      | _ => []);
-    val eqs = maps
-      (fn th => map (pair th) (find_vars (lhs_of th))) thms;
-    fun mk_thms (th, (ct, cv')) =
-      let
-        val th' =
-          Thm.implies_elim
-           (Conv.fconv_rule (Thm.beta_conversion true)
-             (Drule.instantiate'
-               [SOME (ctyp_of_term ct)] [SOME (Thm.lambda cv ct),
-                 SOME (Thm.lambda cv' (rhs_of th)), NONE, SOME cv']
-               @{thm Suc_if_eq})) (Thm.forall_intr cv' th)
-      in
-        case map_filter (fn th'' =>
-            SOME (th'', singleton
-              (Variable.trade (K (fn [th'''] => [th''' RS th']))
-                (Variable.global_thm_context th'')) th'')
-          handle THM _ => NONE) thms of
-            [] => NONE
-          | thps =>
-              let val (ths1, ths2) = split_list thps
-              in SOME (subtract Thm.eq_thm (th :: ths1) thms @ ths2) end
-      end
-  in get_first mk_thms eqs end;
-
-fun eqn_suc_base_preproc thy thms =
-  let
-    val dest = fst o Logic.dest_equals 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 thms |> perhaps_loop (remove_suc thy) |> (Option.map o map) Drule.zero_var_indexes
-       else NONE
-  end;
-
-val eqn_suc_preproc = Code_Preproc.simple_functrans eqn_suc_base_preproc;
-
-in
-
-  Code_Preproc.add_functrans ("eqn_Suc", eqn_suc_preproc)
-
-end;
-*}
-(*>*)
-
-
-subsection {* Target language setup *}
+subsection {* Target language fundamentals *}
 
 text {*
   For ML, we map @{typ nat} to target language integers, where we
@@ -282,47 +123,32 @@
 code_instance nat :: equal
   (Haskell -)
 
-text {*
-  Natural numerals.
-*}
-
-lemma [code_abbrev]:
-  "number_nat_inst.number_of_nat i = nat (number_of i)"
-  -- {* this interacts as desired with @{thm nat_number_of_def} *}
-  by (simp add: number_nat_inst.number_of_nat)
-
 setup {*
-  fold (Numeral.add_code @{const_name number_nat_inst.number_of_nat}
+  fold (Numeral.add_code @{const_name nat_of_num}
     false Code_Printer.literal_positive_numeral) ["SML", "OCaml", "Haskell", "Scala"]
 *}
 
+code_const "0::nat"
+  (SML "0")
+  (OCaml "Big'_int.zero'_big'_int")
+  (Haskell "0")
+  (Scala "Nat(0)")
+
+
+subsection {* Conversions *}
+
 text {*
   Since natural numbers are implemented
-  using integers in ML, the coercion function @{const "of_nat"} of type
+  using integers in ML, the coercion function @{term "int"} of type
   @{typ "nat \<Rightarrow> int"} is simply implemented by the identity function.
   For the @{const nat} function for converting an integer to a natural
-  number, we give a specific implementation using an ML function that
+  number, we give a specific implementation using an ML expression that
   returns its input value, provided that it is non-negative, and otherwise
   returns @{text "0"}.
 *}
 
 definition int :: "nat \<Rightarrow> int" where
-  [code del, code_abbrev]: "int = of_nat"
-
-lemma int_code' [code]:
-  "int (number_of l) = (if neg (number_of l \<Colon> int) then 0 else number_of l)"
-  unfolding int_nat_number_of [folded int_def] ..
-
-lemma nat_code' [code]:
-  "nat (number_of l) = (if neg (number_of l \<Colon> int) then 0 else number_of l)"
-  unfolding nat_number_of_def number_of_is_id neg_def by simp
-
-lemma of_nat_int: (* FIXME delete candidate *)
-  "of_nat = int" by (simp add: int_def)
-
-lemma of_nat_aux_int [code_unfold]:
-  "of_nat_aux (\<lambda>i. i + 1) k 0 = int k"
-  by (simp add: int_def Nat.of_nat_code)
+  [code_abbrev]: "int = of_nat"
 
 code_const int
   (SML "_")
@@ -331,7 +157,7 @@
 code_const nat
   (SML "IntInf.max/ (0,/ _)")
   (OCaml "Big'_int.max'_big'_int/ Big'_int.zero'_big'_int")
-  (Eval "Integer.max/ _/ 0")
+  (Eval "Integer.max/ 0")
 
 text {* For Haskell and Scala, things are slightly different again. *}
 
@@ -339,7 +165,26 @@
   (Haskell "toInteger" and "fromInteger")
   (Scala "!_.as'_BigInt" and "Nat")
 
-text {* Conversion from and to code numerals. *}
+text {* Alternativ implementation for @{const of_nat} *}
+
+lemma [code]:
+  "of_nat n = (if n = 0 then 0 else
+     let
+       (q, m) = divmod_nat n 2;
+       q' = 2 * of_nat q
+     in if m = 0 then q' else q' + 1)"
+proof -
+  from mod_div_equality have *: "of_nat n = of_nat (n div 2 * 2 + n mod 2)" by simp
+  show ?thesis
+    apply (simp add: Let_def divmod_nat_div_mod mod_2_not_eq_zero_eq_one_nat
+      of_nat_mult
+      of_nat_add [symmetric])
+    apply (auto simp add: of_nat_mult)
+    apply (simp add: * of_nat_mult add_commute mult_commute)
+    done
+qed
+
+text {* Conversion from and to code numerals *}
 
 code_const Code_Numeral.of_nat
   (SML "IntInf.toInt")
@@ -355,21 +200,38 @@
   (Scala "!Nat(_.as'_BigInt)")
   (Eval "_")
 
-text {* Using target language arithmetic operations whenever appropriate *}
+
+subsection {* Target language arithmetic *}
 
-code_const "op + \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
-  (SML "IntInf.+ ((_), (_))")
+code_const "plus \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
+  (SML "IntInf.+/ ((_),/ (_))")
   (OCaml "Big'_int.add'_big'_int")
   (Haskell infixl 6 "+")
   (Scala infixl 7 "+")
   (Eval infixl 8 "+")
 
-code_const "op - \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
+code_const "minus \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
+  (SML "IntInf.max/ (0, IntInf.-/ ((_),/ (_)))")
+  (OCaml "Big'_int.max'_big'_int/ Big'_int.zero'_big'_int/ (Big'_int.sub'_big'_int/ _/ _)")
   (Haskell infixl 6 "-")
   (Scala infixl 7 "-")
+  (Eval "Integer.max/ 0/ (_ -/ _)")
 
-code_const "op * \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
-  (SML "IntInf.* ((_), (_))")
+code_const Code_Nat.dup
+  (SML "IntInf.*/ (2,/ (_))")
+  (OCaml "Big'_int.mult'_big'_int/ 2")
+  (Haskell "!(2 * _)")
+  (Scala "!(2 * _)")
+  (Eval "!(2 * _)")
+
+code_const Code_Nat.sub
+  (SML "!(raise/ Fail/ \"sub\")")
+  (OCaml "failwith/ \"sub\"")
+  (Haskell "error/ \"sub\"")
+  (Scala "!error(\"sub\")")
+
+code_const "times \<Colon> nat \<Rightarrow> nat \<Rightarrow> nat"
+  (SML "IntInf.*/ ((_),/ (_))")
   (OCaml "Big'_int.mult'_big'_int")
   (Haskell infixl 7 "*")
   (Scala infixl 8 "*")
@@ -389,22 +251,28 @@
   (Scala infixl 5 "==")
   (Eval infixl 6 "=")
 
-code_const "op \<le> \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
-  (SML "IntInf.<= ((_), (_))")
+code_const "less_eq \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
+  (SML "IntInf.<=/ ((_),/ (_))")
   (OCaml "Big'_int.le'_big'_int")
   (Haskell infix 4 "<=")
   (Scala infixl 4 "<=")
   (Eval infixl 6 "<=")
 
-code_const "op < \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
-  (SML "IntInf.< ((_), (_))")
+code_const "less \<Colon> nat \<Rightarrow> nat \<Rightarrow> bool"
+  (SML "IntInf.</ ((_),/ (_))")
   (OCaml "Big'_int.lt'_big'_int")
   (Haskell infix 4 "<")
   (Scala infixl 4 "<")
   (Eval infixl 6 "<")
 
+code_const Num.num_of_nat
+  (SML "!(raise/ Fail/ \"num'_of'_nat\")")
+  (OCaml "failwith/ \"num'_of'_nat\"")
+  (Haskell "error/ \"num'_of'_nat\"")
+  (Scala "!error(\"num'_of'_nat\")")
 
-text {* Evaluation *}
+
+subsection {* Evaluation *}
 
 lemma [code, code del]:
   "(Code_Evaluation.term_of \<Colon> nat \<Rightarrow> term) = Code_Evaluation.term_of" ..
@@ -412,14 +280,14 @@
 code_const "Code_Evaluation.term_of \<Colon> nat \<Rightarrow> term"
   (SML "HOLogic.mk'_number/ HOLogic.natT")
 
-text {* Evaluation with @{text "Quickcheck_Narrowing"} does not work, as
+text {*
+  FIXME -- Evaluation with @{text "Quickcheck_Narrowing"} does not work, as
   @{text "code_module"} is very aggressive leading to bad Haskell code.
   Therefore, we simply deactivate the narrowing-based quickcheck from here on.
 *}
 
 declare [[quickcheck_narrowing_active = false]] 
 
-text {* Module names *}
 
 code_modulename SML
   Efficient_Nat Arith
@@ -430,6 +298,6 @@
 code_modulename Haskell
   Efficient_Nat Arith
 
-hide_const int
+hide_const (open) int
 
 end
--- a/src/HOL/Library/Extended_Nat.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/Extended_Nat.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -61,19 +61,17 @@
 primrec the_enat :: "enat \<Rightarrow> nat"
   where "the_enat (enat n) = n"
 
+
 subsection {* Constructors and numbers *}
 
-instantiation enat :: "{zero, one, number}"
+instantiation enat :: "{zero, one}"
 begin
 
 definition
   "0 = enat 0"
 
 definition
-  [code_unfold]: "1 = enat 1"
-
-definition
-  [code_unfold, code del]: "number_of k = enat (number_of k)"
+  "1 = enat 1"
 
 instance ..
 
@@ -82,15 +80,12 @@
 definition eSuc :: "enat \<Rightarrow> enat" where
   "eSuc i = (case i of enat n \<Rightarrow> enat (Suc n) | \<infinity> \<Rightarrow> \<infinity>)"
 
-lemma enat_0: "enat 0 = 0"
+lemma enat_0 [code_post]: "enat 0 = 0"
   by (simp add: zero_enat_def)
 
-lemma enat_1: "enat 1 = 1"
+lemma enat_1 [code_post]: "enat 1 = 1"
   by (simp add: one_enat_def)
 
-lemma enat_number: "enat (number_of k) = number_of k"
-  by (simp add: number_of_enat_def)
-
 lemma one_eSuc: "1 = eSuc 0"
   by (simp add: zero_enat_def one_enat_def eSuc_def)
 
@@ -100,16 +95,6 @@
 lemma i0_ne_infinity [simp]: "0 \<noteq> (\<infinity>::enat)"
   by (simp add: zero_enat_def)
 
-lemma zero_enat_eq [simp]:
-  "number_of k = (0\<Colon>enat) \<longleftrightarrow> number_of k = (0\<Colon>nat)"
-  "(0\<Colon>enat) = number_of k \<longleftrightarrow> number_of k = (0\<Colon>nat)"
-  unfolding zero_enat_def number_of_enat_def by simp_all
-
-lemma one_enat_eq [simp]:
-  "number_of k = (1\<Colon>enat) \<longleftrightarrow> number_of k = (1\<Colon>nat)"
-  "(1\<Colon>enat) = number_of k \<longleftrightarrow> number_of k = (1\<Colon>nat)"
-  unfolding one_enat_def number_of_enat_def by simp_all
-
 lemma zero_one_enat_neq [simp]:
   "\<not> 0 = (1\<Colon>enat)"
   "\<not> 1 = (0\<Colon>enat)"
@@ -121,18 +106,9 @@
 lemma i1_ne_infinity [simp]: "1 \<noteq> (\<infinity>::enat)"
   by (simp add: one_enat_def)
 
-lemma infinity_ne_number [simp]: "(\<infinity>::enat) \<noteq> number_of k"
-  by (simp add: number_of_enat_def)
-
-lemma number_ne_infinity [simp]: "number_of k \<noteq> (\<infinity>::enat)"
-  by (simp add: number_of_enat_def)
-
 lemma eSuc_enat: "eSuc (enat n) = enat (Suc n)"
   by (simp add: eSuc_def)
 
-lemma eSuc_number_of: "eSuc (number_of k) = enat (Suc (number_of k))"
-  by (simp add: eSuc_enat number_of_enat_def)
-
 lemma eSuc_infinity [simp]: "eSuc \<infinity> = \<infinity>"
   by (simp add: eSuc_def)
 
@@ -145,11 +121,6 @@
 lemma eSuc_inject [simp]: "eSuc m = eSuc n \<longleftrightarrow> m = n"
   by (simp add: eSuc_def split: enat.splits)
 
-lemma number_of_enat_inject [simp]:
-  "(number_of k \<Colon> enat) = number_of l \<longleftrightarrow> (number_of k \<Colon> nat) = number_of l"
-  by (simp add: number_of_enat_def)
-
-
 subsection {* Addition *}
 
 instantiation enat :: comm_monoid_add
@@ -177,16 +148,6 @@
 
 end
 
-lemma plus_enat_number [simp]:
-  "(number_of k \<Colon> enat) + number_of l = (if k < Int.Pls then number_of l
-    else if l < Int.Pls then number_of k else number_of (k + l))"
-  unfolding number_of_enat_def plus_enat_simps nat_arith(1) if_distrib [symmetric, of _ enat] ..
-
-lemma eSuc_number [simp]:
-  "eSuc (number_of k) = (if neg (number_of k \<Colon> int) then 1 else number_of (Int.succ k))"
-  unfolding eSuc_number_of
-  unfolding one_enat_def number_of_enat_def Suc_nat_number_of if_distrib [symmetric] ..
-
 lemma eSuc_plus_1:
   "eSuc n = n + 1"
   by (cases n) (simp_all add: eSuc_enat one_enat_def)
@@ -261,12 +222,6 @@
   apply (simp add: plus_1_eSuc eSuc_enat)
   done
 
-instance enat :: number_semiring
-proof
-  fix n show "number_of (int n) = (of_nat n :: enat)"
-    unfolding number_of_enat_def number_of_int of_nat_id of_nat_eq_enat ..
-qed
-
 instance enat :: semiring_char_0 proof
   have "inj enat" by (rule injI) simp
   then show "inj (\<lambda>n. of_nat n :: enat)" by (simp add: of_nat_eq_enat)
@@ -279,6 +234,25 @@
   by (auto simp add: times_enat_def zero_enat_def split: enat.split)
 
 
+subsection {* Numerals *}
+
+lemma numeral_eq_enat:
+  "numeral k = enat (numeral k)"
+  using of_nat_eq_enat [of "numeral k"] by simp
+
+lemma enat_numeral [code_abbrev]:
+  "enat (numeral k) = numeral k"
+  using numeral_eq_enat ..
+
+lemma infinity_ne_numeral [simp]: "(\<infinity>::enat) \<noteq> numeral k"
+  by (simp add: numeral_eq_enat)
+
+lemma numeral_ne_infinity [simp]: "numeral k \<noteq> (\<infinity>::enat)"
+  by (simp add: numeral_eq_enat)
+
+lemma eSuc_numeral [simp]: "eSuc (numeral k) = numeral (k + Num.One)"
+  by (simp only: eSuc_plus_1 numeral_plus_one)
+
 subsection {* Subtraction *}
 
 instantiation enat :: minus
@@ -292,13 +266,13 @@
 
 end
 
-lemma idiff_enat_enat [simp,code]: "enat a - enat b = enat (a - b)"
+lemma idiff_enat_enat [simp, code]: "enat a - enat b = enat (a - b)"
   by (simp add: diff_enat_def)
 
-lemma idiff_infinity [simp,code]: "\<infinity> - n = (\<infinity>::enat)"
+lemma idiff_infinity [simp, code]: "\<infinity> - n = (\<infinity>::enat)"
   by (simp add: diff_enat_def)
 
-lemma idiff_infinity_right [simp,code]: "enat a - \<infinity> = 0"
+lemma idiff_infinity_right [simp, code]: "enat a - \<infinity> = 0"
   by (simp add: diff_enat_def)
 
 lemma idiff_0 [simp]: "(0::enat) - n = 0"
@@ -344,13 +318,13 @@
   "(\<infinity>::enat) < q \<longleftrightarrow> False"
   by (simp_all add: less_eq_enat_def less_enat_def split: enat.splits)
 
-lemma number_of_le_enat_iff[simp]:
-  shows "number_of m \<le> enat n \<longleftrightarrow> number_of m \<le> n"
-by (auto simp: number_of_enat_def)
+lemma numeral_le_enat_iff[simp]:
+  shows "numeral m \<le> enat n \<longleftrightarrow> numeral m \<le> n"
+by (auto simp: numeral_eq_enat)
 
-lemma number_of_less_enat_iff[simp]:
-  shows "number_of m < enat n \<longleftrightarrow> number_of m < n"
-by (auto simp: number_of_enat_def)
+lemma numeral_less_enat_iff[simp]:
+  shows "numeral m < enat n \<longleftrightarrow> numeral m < n"
+by (auto simp: numeral_eq_enat)
 
 lemma enat_ord_code [code]:
   "enat m \<le> enat n \<longleftrightarrow> m \<le> n"
@@ -375,10 +349,15 @@
     by (simp split: enat.splits)
 qed
 
+(* BH: These equations are already proven generally for any type in
+class linordered_semidom. However, enat is not in that class because
+it does not have the cancellation property. Would it be worthwhile to
+a generalize linordered_semidom to a new class that includes enat? *)
+
 lemma enat_ord_number [simp]:
-  "(number_of m \<Colon> enat) \<le> number_of n \<longleftrightarrow> (number_of m \<Colon> nat) \<le> number_of n"
-  "(number_of m \<Colon> enat) < number_of n \<longleftrightarrow> (number_of m \<Colon> nat) < number_of n"
-  by (simp_all add: number_of_enat_def)
+  "(numeral m \<Colon> enat) \<le> numeral n \<longleftrightarrow> (numeral m \<Colon> nat) \<le> numeral n"
+  "(numeral m \<Colon> enat) < numeral n \<longleftrightarrow> (numeral m \<Colon> nat) < numeral n"
+  by (simp_all add: numeral_eq_enat)
 
 lemma i0_lb [simp]: "(0\<Colon>enat) \<le> n"
   by (simp add: zero_enat_def less_eq_enat_def split: enat.splits)
@@ -525,10 +504,10 @@
   val find_first = find_first_t []
   val trans_tac = Numeral_Simprocs.trans_tac
   val norm_ss = HOL_basic_ss addsimps
-    @{thms add_ac semiring_numeral_0_eq_0 add_0_left add_0_right}
+    @{thms add_ac add_0_left add_0_right}
   fun norm_tac ss = ALLGOALS (simp_tac (Simplifier.inherit_context ss norm_ss))
   fun simplify_meta_eq ss cancel_th th =
-    Arith_Data.simplify_meta_eq @{thms semiring_numeral_0_eq_0} ss
+    Arith_Data.simplify_meta_eq [] ss
       ([th, cancel_th] MRS trans)
   fun mk_eq (a, b) = HOLogic.mk_Trueprop (HOLogic.mk_eq (a, b))
 end
@@ -646,7 +625,7 @@
 
 subsection {* Traditional theorem names *}
 
-lemmas enat_defs = zero_enat_def one_enat_def number_of_enat_def eSuc_def
+lemmas enat_defs = zero_enat_def one_enat_def eSuc_def
   plus_enat_def less_eq_enat_def less_enat_def
 
 end
--- a/src/HOL/Library/Extended_Real.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/Extended_Real.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -124,11 +124,6 @@
   fix x :: ereal show "x \<in> range uminus" by (intro image_eqI[of _ _ "-x"]) auto
 qed auto
 
-instantiation ereal :: number
-begin
-definition [simp]: "number_of x = ereal (number_of x)"
-instance ..
-end
 
 instantiation ereal :: abs
 begin
@@ -671,6 +666,14 @@
   using assms
   by (cases rule: ereal3_cases[of a b c]) (simp_all add: field_simps)
 
+instance ereal :: numeral ..
+
+lemma numeral_eq_ereal [simp]: "numeral w = ereal (numeral w)"
+  apply (induct w rule: num_induct)
+  apply (simp only: numeral_One one_ereal_def)
+  apply (simp only: numeral_inc ereal_plus_1)
+  done
+
 lemma ereal_le_epsilon:
   fixes x y :: ereal
   assumes "ALL e. 0 < e --> x <= y + e"
@@ -781,8 +784,8 @@
   shows "(- x) ^ n = (if even n then x ^ n else - (x^n))"
   by (induct n) (auto simp: one_ereal_def)
 
-lemma ereal_power_number_of[simp]:
-  "(number_of num :: ereal) ^ n = ereal (number_of num ^ n)"
+lemma ereal_power_numeral[simp]:
+  "(numeral num :: ereal) ^ n = ereal (numeral num ^ n)"
   by (induct n) (auto simp: one_ereal_def)
 
 lemma zero_le_power_ereal[simp]:
@@ -1730,8 +1733,8 @@
   "ereal_of_enat m \<le> ereal_of_enat n \<longleftrightarrow> m \<le> n"
 by (cases m n rule: enat2_cases) auto
 
-lemma number_of_le_ereal_of_enat_iff[simp]:
-  shows "number_of m \<le> ereal_of_enat n \<longleftrightarrow> number_of m \<le> n"
+lemma numeral_le_ereal_of_enat_iff[simp]:
+  shows "numeral m \<le> ereal_of_enat n \<longleftrightarrow> numeral m \<le> n"
 by (cases n) (auto dest: natceiling_le intro: natceiling_le_eq[THEN iffD1])
 
 lemma ereal_of_enat_ge_zero_cancel_iff[simp]:
--- a/src/HOL/Library/Float.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/Float.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -41,18 +41,6 @@
 instance ..
 end
 
-instantiation float :: number
-begin
-definition number_of_float where "number_of n = Float n 0"
-instance ..
-end
-
-lemma number_of_float_Float:
-  "number_of k = Float (number_of k) 0"
-  by (simp add: number_of_float_def number_of_is_id)
-
-declare number_of_float_Float [symmetric, code_abbrev]
-
 lemma real_of_float_simp[simp]: "real (Float a b) = real a * pow2 b"
   unfolding real_of_float_def using of_float.simps .
 
@@ -63,12 +51,9 @@
 lemma Float_num[simp]: shows
    "real (Float 1 0) = 1" and "real (Float 1 1) = 2" and "real (Float 1 2) = 4" and
    "real (Float 1 -1) = 1/2" and "real (Float 1 -2) = 1/4" and "real (Float 1 -3) = 1/8" and
-   "real (Float -1 0) = -1" and "real (Float (number_of n) 0) = number_of n"
+   "real (Float -1 0) = -1" and "real (Float (numeral n) 0) = numeral n"
   by auto
 
-lemma float_number_of[simp]: "real (number_of x :: float) = number_of x"
-  by (simp only:number_of_float_def Float_num[unfolded number_of_is_id])
-
 lemma float_number_of_int[simp]: "real (Float n 0) = real n"
   by simp
 
@@ -349,6 +334,21 @@
     by (cases a, cases b) (simp add: plus_float.simps)
 qed
 
+instance float :: numeral ..
+
+lemma Float_add_same_scale: "Float x e + Float y e = Float (x + y) e"
+  by (simp add: plus_float.simps)
+
+(* FIXME: define other constant for code_unfold_post *)
+lemma numeral_float_Float (*[code_unfold_post]*):
+  "numeral k = Float (numeral k) 0"
+  by (induct k, simp_all only: numeral.simps one_float_def
+    Float_add_same_scale)
+
+lemma float_number_of[simp]: "real (numeral x :: float) = numeral x"
+  by (simp only: numeral_float_Float Float_num)
+
+
 instance float :: comm_monoid_mult
 proof (intro_classes)
   fix a b c :: float
@@ -555,6 +555,7 @@
   show ?thesis unfolding real_of_float_nge0_exp[OF P] divide_inverse by auto
 qed
 
+(* BROKEN
 lemma bitlen_Pls: "bitlen (Int.Pls) = Int.Pls" by (subst Pls_def, subst Pls_def, simp)
 
 lemma bitlen_Min: "bitlen (Int.Min) = Int.Bit1 Int.Pls" by (subst Min_def, simp add: Bit1_def) 
@@ -588,6 +589,7 @@
 
 lemma bitlen_number_of: "bitlen (number_of w) = number_of (bitlen w)"
   by (simp add: number_of_is_id)
+BH *)
 
 lemma [code]: "bitlen x = 
      (if x = 0  then 0 
@@ -722,12 +724,12 @@
     hence "real x / real y < 1" using `0 < y` and `0 \<le> x` by auto
 
     from real_of_int_div4[of "?X" y]
-    have "real (?X div y) \<le> (real x / real y) * 2^?l" unfolding real_of_int_mult times_divide_eq_left real_of_int_power real_number_of .
+    have "real (?X div y) \<le> (real x / real y) * 2^?l" unfolding real_of_int_mult times_divide_eq_left real_of_int_power real_numeral .
     also have "\<dots> < 1 * 2^?l" using `real x / real y < 1` by (rule mult_strict_right_mono, auto)
     finally have "?X div y < 2^?l" unfolding real_of_int_less_iff[of _ "2^?l", symmetric] by auto
     hence "?X div y + 1 \<le> 2^?l" by auto
     hence "real (?X div y + 1) * inverse (2^?l) \<le> 2^?l * inverse (2^?l)"
-      unfolding real_of_int_le_iff[of _ "2^?l", symmetric] real_of_int_power real_number_of
+      unfolding real_of_int_le_iff[of _ "2^?l", symmetric] real_of_int_power real_numeral
       by (rule mult_right_mono, auto)
     hence "real (?X div y + 1) * inverse (2^?l) \<le> 1" by auto
     thus ?thesis unfolding rapprox_posrat_def Let_def normfloat real_of_float_simp if_not_P[OF False]
@@ -796,12 +798,12 @@
     qed
 
     from real_of_int_div4[of "?X" y]
-    have "real (?X div y) \<le> (real x / real y) * 2^?l" unfolding real_of_int_mult times_divide_eq_left real_of_int_power real_number_of .
+    have "real (?X div y) \<le> (real x / real y) * 2^?l" unfolding real_of_int_mult times_divide_eq_left real_of_int_power real_numeral .
     also have "\<dots> < 1/2 * 2^?l" using `real x / real y < 1/2` by (rule mult_strict_right_mono, auto)
     finally have "?X div y * 2 < 2^?l" unfolding real_of_int_less_iff[of _ "2^?l", symmetric] by auto
     hence "?X div y + 1 < 2^?l" using `0 < ?X div y` by auto
     hence "real (?X div y + 1) * inverse (2^?l) < 2^?l * inverse (2^?l)"
-      unfolding real_of_int_less_iff[of _ "2^?l", symmetric] real_of_int_power real_number_of
+      unfolding real_of_int_less_iff[of _ "2^?l", symmetric] real_of_int_power real_numeral
       by (rule mult_strict_right_mono, auto)
     hence "real (?X div y + 1) * inverse (2^?l) < 1" by auto
     thus ?thesis unfolding rapprox_posrat_def Let_def normfloat real_of_float_simp if_not_P[OF False]
@@ -1195,7 +1197,7 @@
     case True
     have "real (m div 2^(nat ?l)) * pow2 ?l \<le> real m"
     proof -
-      have "real (m div 2^(nat ?l)) * pow2 ?l = real (2^(nat ?l) * (m div 2^(nat ?l)))" unfolding real_of_int_mult real_of_int_power real_number_of unfolding pow2_int[symmetric] 
+      have "real (m div 2^(nat ?l)) * pow2 ?l = real (2^(nat ?l) * (m div 2^(nat ?l)))" unfolding real_of_int_mult real_of_int_power real_numeral unfolding pow2_int[symmetric] 
         using `?l > 0` by auto
       also have "\<dots> \<le> real (2^(nat ?l) * (m div 2^(nat ?l)) + m mod 2^(nat ?l))" unfolding real_of_int_add by auto
       also have "\<dots> = real m" unfolding zmod_zdiv_equality[symmetric] ..
@@ -1262,7 +1264,7 @@
     hence me_eq: "pow2 (-e) = pow2 (int (nat (-e)))" by auto
     have "real (Float (m div (2 ^ (nat (-e)))) 0) = real (m div 2 ^ (nat (-e)))" unfolding real_of_float_simp by auto
     also have "\<dots> \<le> real m / real ((2::int) ^ (nat (-e)))" using real_of_int_div4 .
-    also have "\<dots> = real m * inverse (2 ^ (nat (-e)))" unfolding real_of_int_power real_number_of divide_inverse ..
+    also have "\<dots> = real m * inverse (2 ^ (nat (-e)))" unfolding real_of_int_power real_numeral divide_inverse ..
     also have "\<dots> = real (Float m e)" unfolding real_of_float_simp me_eq pow2_int pow2_neg[of e] ..
     finally show ?thesis unfolding Float floor_fl.simps if_not_P[OF `\<not> 0 \<le> e`] .
   next
@@ -1290,7 +1292,7 @@
     case False
     hence me_eq: "pow2 (-e) = pow2 (int (nat (-e)))" by auto
     have "real (Float m e) = real m * inverse (2 ^ (nat (-e)))" unfolding real_of_float_simp me_eq pow2_int pow2_neg[of e] ..
-    also have "\<dots> = real m / real ((2::int) ^ (nat (-e)))" unfolding real_of_int_power real_number_of divide_inverse ..
+    also have "\<dots> = real m / real ((2::int) ^ (nat (-e)))" unfolding real_of_int_power real_numeral divide_inverse ..
     also have "\<dots> \<le> 1 + real (m div 2 ^ (nat (-e)))" using real_of_int_div3[unfolded diff_le_eq] .
     also have "\<dots> = real (Float (m div (2 ^ (nat (-e))) + 1) 0)" unfolding real_of_float_simp by auto
     finally show ?thesis unfolding Float ceiling_fl.simps if_not_P[OF `\<not> 0 \<le> e`] .
--- a/src/HOL/Library/Formal_Power_Series.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/Formal_Power_Series.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -392,25 +392,13 @@
 
 instance fps :: (idom) idom ..
 
-instantiation fps :: (comm_ring_1) number_ring
-begin
-definition number_of_fps_def: "(number_of k::'a fps) = of_int k"
-
-instance proof
-qed (rule number_of_fps_def)
-end
-
-lemma number_of_fps_const: "(number_of k::('a::comm_ring_1) fps) = fps_const (of_int k)"
-  
-proof(induct k rule: int_induct [where k=0])
-  case base thus ?case unfolding number_of_fps_def of_int_0 by simp
-next
-  case (step1 i) thus ?case unfolding number_of_fps_def 
-    by (simp add: fps_const_add[symmetric] del: fps_const_add)
-next
-  case (step2 i) thus ?case unfolding number_of_fps_def 
-    by (simp add: fps_const_sub[symmetric] del: fps_const_sub)
-qed
+lemma numeral_fps_const: "numeral k = fps_const (numeral k)"
+  by (induct k, simp_all only: numeral.simps fps_const_1_eq_1
+    fps_const_add [symmetric])
+
+lemma neg_numeral_fps_const: "neg_numeral k = fps_const (neg_numeral k)"
+  by (simp only: neg_numeral_def numeral_fps_const fps_const_neg)
+
 subsection{* The eXtractor series X*}
 
 lemma minus_one_power_iff: "(- (1::'a :: {comm_ring_1})) ^ n = (if even n then 1 else - 1)"
@@ -1119,7 +1107,7 @@
   have eq: "(1 + X) * ?r = 1"
     unfolding minus_one_power_iff
     by (auto simp add: field_simps fps_eq_iff)
-  show ?thesis by (auto simp add: eq intro: fps_inverse_unique)
+  show ?thesis by (auto simp add: eq intro: fps_inverse_unique simp del: minus_one)
 qed
 
 
@@ -1157,8 +1145,11 @@
   "fps_const (a::'a::{comm_ring_1}) oo b = fps_const (a)"
   by (simp add: fps_eq_iff fps_compose_nth mult_delta_left setsum_delta)
 
-lemma number_of_compose[simp]: "(number_of k::('a::{comm_ring_1}) fps) oo b = number_of k"
-  unfolding number_of_fps_const by simp
+lemma numeral_compose[simp]: "(numeral k::('a::{comm_ring_1}) fps) oo b = numeral k"
+  unfolding numeral_fps_const by simp
+
+lemma neg_numeral_compose[simp]: "(neg_numeral k::('a::{comm_ring_1}) fps) oo b = neg_numeral k"
+  unfolding neg_numeral_fps_const by simp
 
 lemma X_fps_compose_startby0[simp]: "a$0 = 0 \<Longrightarrow> X oo a = (a :: ('a :: comm_ring_1) fps)"
   by (simp add: fps_eq_iff fps_compose_def mult_delta_left setsum_delta
@@ -2568,7 +2559,7 @@
   (is "inverse ?l = ?r")
 proof-
   have th: "?l * ?r = 1"
-    by (auto simp add: field_simps fps_eq_iff minus_one_power_iff)
+    by (auto simp add: field_simps fps_eq_iff minus_one_power_iff simp del: minus_one)
   have th': "?l $ 0 \<noteq> 0" by (simp add: )
   from fps_inverse_unique[OF th' th] show ?thesis .
 qed
@@ -2765,7 +2756,7 @@
 proof-
   have th: "?r$0 \<noteq> 0" by simp
   have th': "fps_deriv (inverse ?r) = fps_const (- 1) * inverse ?r / (1 + X)"
-    by (simp add: fps_inverse_deriv[OF th] fps_divide_def power2_eq_square mult_commute fps_const_neg[symmetric] del: fps_const_neg)
+    by (simp add: fps_inverse_deriv[OF th] fps_divide_def power2_eq_square mult_commute fps_const_neg[symmetric] del: fps_const_neg minus_one)
   have eq: "inverse ?r $ 0 = 1"
     by (simp add: fps_inverse_def)
   from iffD1[OF fps_binomial_ODE_unique[of "inverse (1 + X)" "- 1"] th'] eq
@@ -2855,7 +2846,7 @@
           unfolding m1nk 
           
           unfolding m h pochhammer_Suc_setprod
-          apply (simp add: field_simps del: fact_Suc id_def)
+          apply (simp add: field_simps del: fact_Suc id_def minus_one)
           unfolding fact_altdef_nat id_def
           unfolding of_nat_setprod
           unfolding setprod_timesf[symmetric]
@@ -3162,28 +3153,25 @@
 lemma fps_const_minus: "fps_const (c::'a::group_add) - fps_const d = fps_const (c - d)"
   by (simp add: fps_eq_iff fps_const_def)
 
-lemma fps_number_of_fps_const: "number_of i = fps_const (number_of i :: 'a:: {comm_ring_1, number_ring})"
-  apply (subst (2) number_of_eq)
-apply(rule int_induct [of _ 0])
-apply (simp_all add: number_of_fps_def)
-by (simp_all add: fps_const_add[symmetric] fps_const_minus[symmetric])
+lemma fps_numeral_fps_const: "numeral i = fps_const (numeral i :: 'a:: {comm_ring_1})"
+  by (fact numeral_fps_const) (* FIXME: duplicate *)
 
 lemma fps_cos_Eii:
   "fps_cos c = (E (ii * c) + E (- ii * c)) / fps_const 2"
 proof-
   have th: "fps_cos c + fps_cos c = fps_cos c * fps_const 2" 
-    by (simp add: fps_eq_iff fps_number_of_fps_const complex_number_of_def[symmetric])
+    by (simp add: numeral_fps_const)
   show ?thesis
   unfolding Eii_sin_cos minus_mult_commute
-  by (simp add: fps_sin_even fps_cos_odd fps_number_of_fps_const
-    fps_divide_def fps_const_inverse th complex_number_of_def[symmetric])
+  by (simp add: fps_sin_even fps_cos_odd numeral_fps_const
+    fps_divide_def fps_const_inverse th)
 qed
 
 lemma fps_sin_Eii:
   "fps_sin c = (E (ii * c) - E (- ii * c)) / fps_const (2*ii)"
 proof-
   have th: "fps_const \<i> * fps_sin c + fps_const \<i> * fps_sin c = fps_sin c * fps_const (2 * ii)" 
-    by (simp add: fps_eq_iff fps_number_of_fps_const complex_number_of_def[symmetric])
+    by (simp add: fps_eq_iff numeral_fps_const)
   show ?thesis
   unfolding Eii_sin_cos minus_mult_commute
   by (simp add: fps_sin_even fps_cos_odd fps_divide_def fps_const_inverse th)
--- a/src/HOL/Library/Numeral_Type.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/Numeral_Type.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -66,7 +66,6 @@
     by simp
 qed
 
-
 subsection {* Locales for for modular arithmetic subtypes *}
 
 locale mod_type =
@@ -137,8 +136,8 @@
 
 locale mod_ring = mod_type n Rep Abs
   for n :: int
-  and Rep :: "'a::{number_ring} \<Rightarrow> int"
-  and Abs :: "int \<Rightarrow> 'a::{number_ring}"
+  and Rep :: "'a::{comm_ring_1} \<Rightarrow> int"
+  and Abs :: "int \<Rightarrow> 'a::{comm_ring_1}"
 begin
 
 lemma of_nat_eq: "of_nat k = Abs (int k mod n)"
@@ -152,13 +151,14 @@
 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 Rep_numeral:
+  "Rep (numeral w) = numeral w mod n"
+using of_int_eq [of "numeral w"]
+by (simp add: Rep_inject_sym 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 iszero_numeral:
+  "iszero (numeral w::'a) \<longleftrightarrow> numeral w mod n = 0"
+by (simp add: Rep_inject_sym Rep_numeral Rep_0 iszero_def)
 
 lemma cases:
   assumes 1: "\<And>z. \<lbrakk>(x::'a) = of_int z; 0 \<le> z; z < n\<rbrakk> \<Longrightarrow> P"
@@ -175,14 +175,14 @@
 end
 
 
-subsection {* Number ring instances *}
+subsection {* Ring class instances *}
 
 text {*
-  Unfortunately a number ring instance is not possible for
+  Unfortunately @{text ring_1} instance is not possible for
   @{typ num1}, since 0 and 1 are not distinct.
 *}
 
-instantiation num1 :: "{comm_ring,comm_monoid_mult,number}"
+instantiation num1 :: "{comm_ring,comm_monoid_mult,numeral}"
 begin
 
 lemma num1_eq_iff: "(x::num1) = (y::num1) \<longleftrightarrow> True"
@@ -252,22 +252,10 @@
 done
 
 instance bit0 :: (finite) comm_ring_1
-  by (rule bit0.comm_ring_1)+
+  by (rule bit0.comm_ring_1)
 
 instance bit1 :: (finite) comm_ring_1
-  by (rule bit1.comm_ring_1)+
-
-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
+  by (rule bit1.comm_ring_1)
 
 interpretation bit0:
   mod_ring "int CARD('a::finite bit0)"
@@ -289,9 +277,11 @@
 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
+lemmas bit0_iszero_numeral [simp] = bit0.iszero_numeral
+lemmas bit1_iszero_numeral [simp] = bit1.iszero_numeral
 
+declare eq_numeral_iff_iszero [where 'a="('a::finite) bit0", standard, simp]
+declare eq_numeral_iff_iszero [where 'a="('a::finite) bit1", standard, simp]
 
 subsection {* Syntax *}
 
--- a/src/HOL/Library/Poly_Deriv.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/Poly_Deriv.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -71,7 +71,8 @@
 apply (subst power_Suc)
 apply (subst pderiv_mult)
 apply (erule ssubst)
-apply (simp add: smult_add_left algebra_simps)
+apply (simp only: of_nat_Suc smult_add_left smult_1_left)
+apply (simp add: algebra_simps) (* FIXME *)
 done
 
 lemma DERIV_cmult2: "DERIV f x :> D ==> DERIV (%x. (f x) * c :: real) x :> D * c"
--- a/src/HOL/Library/Polynomial.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/Polynomial.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -662,17 +662,6 @@
 
 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 *}
 
@@ -1052,12 +1041,12 @@
 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
+  using div_smult_left [of "- 1::'a"] by (simp del: minus_one) (* FIXME *)
 
 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
+  using mod_smult_left [of "- 1::'a"] by (simp del: minus_one) (* FIXME *)
 
 lemma pdivmod_rel_smult_right:
   "\<lbrakk>a \<noteq> 0; pdivmod_rel x y q r\<rbrakk>
@@ -1075,12 +1064,12 @@
   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)
+  by (simp add: nonzero_inverse_minus_eq del: minus_one) (* FIXME *)
 
 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
+  using mod_smult_right [of "- 1::'a"] by (simp del: minus_one) (* FIXME *)
 
 lemma pdivmod_rel_mult:
   "\<lbrakk>pdivmod_rel x y q r; pdivmod_rel q z q' r'\<rbrakk>
--- a/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/Predicate_Compile_Alternative_Defs.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -54,8 +54,8 @@
 
 section {* Setup for Numerals *}
 
-setup {* Predicate_Compile_Data.ignore_consts [@{const_name number_of}] *}
-setup {* Predicate_Compile_Data.keep_functions [@{const_name number_of}] *}
+setup {* Predicate_Compile_Data.ignore_consts [@{const_name numeral}, @{const_name neg_numeral}] *}
+setup {* Predicate_Compile_Data.keep_functions [@{const_name numeral}, @{const_name neg_numeral}] *}
 
 setup {* Predicate_Compile_Data.ignore_consts [@{const_name div}, @{const_name mod}, @{const_name times}] *}
 
--- a/src/HOL/Library/ROOT.ML	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/ROOT.ML	Sun Mar 25 20:15:39 2012 +0200
@@ -4,4 +4,4 @@
 use_thys ["Library", "List_Cset", "List_Prefix", "List_lexord", "Sublist_Order",
   "Product_Lattice",
   "Code_Char_chr", "Code_Char_ord", "Code_Integer", "Efficient_Nat"(*, "Code_Prolog"*),
-  "Code_Real_Approx_By_Float" ];
+  "Code_Real_Approx_By_Float", "Target_Numeral"];
--- a/src/HOL/Library/Saturated.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/Saturated.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -157,20 +157,16 @@
   "nat_of (Sat n :: ('a::len) sat) = min (len_of TYPE('a)) n"
   by (rule nat_of_Abs_sat' [unfolded Abs_sat'_eq_of_nat])
 
-instantiation sat :: (len) number_semiring
-begin
+lemma [code_abbrev]:
+  "of_nat (numeral k) = (numeral k :: 'a::len sat)"
+  by simp
 
-definition
-  number_of_sat_def [code del]: "number_of = Sat \<circ> nat"
-
-instance
-  by default (simp add: number_of_sat_def)
-
-end
+definition sat_of_nat :: "nat \<Rightarrow> ('a::len) sat"
+  where [code_abbrev]: "sat_of_nat = of_nat"
 
 lemma [code abstract]:
-  "nat_of (number_of n :: ('a::len) sat) = min (nat n) (len_of TYPE('a))"
-  unfolding number_of_sat_def by simp
+  "nat_of (sat_of_nat n :: ('a::len) sat) = min (len_of TYPE('a)) n"
+  by (simp add: sat_of_nat_def)
 
 instance sat :: (len) finite
 proof
@@ -252,4 +248,6 @@
 
 end
 
+hide_const (open) sat_of_nat
+
 end
--- a/src/HOL/Library/Sum_of_Squares/sum_of_squares.ML	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Library/Sum_of_Squares/sum_of_squares.ML	Sun Mar 25 20:15:39 2012 +0200
@@ -866,10 +866,11 @@
    @{term "op / :: real => _"}, @{term "inverse :: real => _"},
    @{term "op ^ :: real => _"}, @{term "abs :: real => _"},
    @{term "min :: real => _"}, @{term "max :: real => _"},
-   @{term "0::real"}, @{term "1::real"}, @{term "number_of :: int => real"},
-   @{term "number_of :: int => nat"},
-   @{term "Int.Bit0"}, @{term "Int.Bit1"},
-   @{term "Int.Pls"}, @{term "Int.Min"}];
+   @{term "0::real"}, @{term "1::real"},
+   @{term "numeral :: num => nat"},
+   @{term "numeral :: num => real"},
+   @{term "neg_numeral :: num => real"},
+   @{term "Num.Bit0"}, @{term "Num.Bit1"}, @{term "Num.One"}];
 
 fun check_sos kcts ct =
  let
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Library/Target_Numeral.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -0,0 +1,726 @@
+theory Target_Numeral
+imports Main Code_Nat
+begin
+
+subsection {* Type of target language numerals *}
+
+typedef (open) int = "UNIV \<Colon> int set"
+  morphisms int_of of_int ..
+
+hide_type (open) int
+hide_const (open) of_int
+
+lemma int_eq_iff:
+  "k = l \<longleftrightarrow> int_of k = int_of l"
+  using int_of_inject [of k l] ..
+
+lemma int_eqI:
+  "int_of k = int_of l \<Longrightarrow> k = l"
+  using int_eq_iff [of k l] by simp
+
+lemma int_of_int [simp]:
+  "int_of (Target_Numeral.of_int k) = k"
+  using of_int_inverse [of k] by simp
+
+lemma of_int_of [simp]:
+  "Target_Numeral.of_int (int_of k) = k"
+  using int_of_inverse [of k] by simp
+
+hide_fact (open) int_eq_iff int_eqI
+
+instantiation Target_Numeral.int :: ring_1
+begin
+
+definition
+  "0 = Target_Numeral.of_int 0"
+
+lemma int_of_zero [simp]:
+  "int_of 0 = 0"
+  by (simp add: zero_int_def)
+
+definition
+  "1 = Target_Numeral.of_int 1"
+
+lemma int_of_one [simp]:
+  "int_of 1 = 1"
+  by (simp add: one_int_def)
+
+definition
+  "k + l = Target_Numeral.of_int (int_of k + int_of l)"
+
+lemma int_of_plus [simp]:
+  "int_of (k + l) = int_of k + int_of l"
+  by (simp add: plus_int_def)
+
+definition
+  "- k = Target_Numeral.of_int (- int_of k)"
+
+lemma int_of_uminus [simp]:
+  "int_of (- k) = - int_of k"
+  by (simp add: uminus_int_def)
+
+definition
+  "k - l = Target_Numeral.of_int (int_of k - int_of l)"
+
+lemma int_of_minus [simp]:
+  "int_of (k - l) = int_of k - int_of l"
+  by (simp add: minus_int_def)
+
+definition
+  "k * l = Target_Numeral.of_int (int_of k * int_of l)"
+
+lemma int_of_times [simp]:
+  "int_of (k * l) = int_of k * int_of l"
+  by (simp add: times_int_def)
+
+instance proof
+qed (auto simp add: Target_Numeral.int_eq_iff algebra_simps)
+
+end
+
+lemma int_of_of_nat [simp]:
+  "int_of (of_nat n) = of_nat n"
+  by (induct n) simp_all
+
+definition nat_of :: "Target_Numeral.int \<Rightarrow> nat" where
+  "nat_of k = Int.nat (int_of k)"
+
+lemma nat_of_of_nat [simp]:
+  "nat_of (of_nat n) = n"
+  by (simp add: nat_of_def)
+
+lemma int_of_of_int [simp]:
+  "int_of (of_int k) = k"
+  by (induct k) (simp_all, simp only: neg_numeral_def numeral_One int_of_uminus int_of_one)
+
+lemma of_int_of_int [simp, code_abbrev]:
+  "Target_Numeral.of_int = of_int"
+  by rule (simp add: Target_Numeral.int_eq_iff)
+
+lemma int_of_numeral [simp]:
+  "int_of (numeral k) = numeral k"
+  using int_of_of_int [of "numeral k"] by simp
+
+lemma int_of_neg_numeral [simp]:
+  "int_of (neg_numeral k) = neg_numeral k"
+  by (simp only: neg_numeral_def int_of_uminus) simp
+
+lemma int_of_sub [simp]:
+  "int_of (Num.sub k l) = Num.sub k l"
+  by (simp only: Num.sub_def int_of_minus int_of_numeral)
+
+instantiation Target_Numeral.int :: "{ring_div, equal, linordered_idom}"
+begin
+
+definition
+  "k div l = of_int (int_of k div int_of l)"
+
+lemma int_of_div [simp]:
+  "int_of (k div l) = int_of k div int_of l"
+  by (simp add: div_int_def)
+
+definition
+  "k mod l = of_int (int_of k mod int_of l)"
+
+lemma int_of_mod [simp]:
+  "int_of (k mod l) = int_of k mod int_of l"
+  by (simp add: mod_int_def)
+
+definition
+  "\<bar>k\<bar> = of_int \<bar>int_of k\<bar>"
+
+lemma int_of_abs [simp]:
+  "int_of \<bar>k\<bar> = \<bar>int_of k\<bar>"
+  by (simp add: abs_int_def)
+
+definition
+  "sgn k = of_int (sgn (int_of k))"
+
+lemma int_of_sgn [simp]:
+  "int_of (sgn k) = sgn (int_of k)"
+  by (simp add: sgn_int_def)
+
+definition
+  "k \<le> l \<longleftrightarrow> int_of k \<le> int_of l"
+
+definition
+  "k < l \<longleftrightarrow> int_of k < int_of l"
+
+definition
+  "HOL.equal k l \<longleftrightarrow> HOL.equal (int_of k) (int_of l)"
+
+instance proof
+qed (auto simp add: Target_Numeral.int_eq_iff algebra_simps
+  less_eq_int_def less_int_def equal_int_def equal)
+
+end
+
+lemma int_of_min [simp]:
+  "int_of (min k l) = min (int_of k) (int_of l)"
+  by (simp add: min_def less_eq_int_def)
+
+lemma int_of_max [simp]:
+  "int_of (max k l) = max (int_of k) (int_of l)"
+  by (simp add: max_def less_eq_int_def)
+
+
+subsection {* Code theorems for target language numerals *}
+
+text {* Constructors *}
+
+definition Pos :: "num \<Rightarrow> Target_Numeral.int" where
+  [simp, code_abbrev]: "Pos = numeral"
+
+definition Neg :: "num \<Rightarrow> Target_Numeral.int" where
+  [simp, code_abbrev]: "Neg = neg_numeral"
+
+code_datatype "0::Target_Numeral.int" Pos Neg
+
+
+text {* Auxiliary operations *}
+
+definition dup :: "Target_Numeral.int \<Rightarrow> Target_Numeral.int" where
+  [simp]: "dup k = k + k"
+
+lemma dup_code [code]:
+  "dup 0 = 0"
+  "dup (Pos n) = Pos (Num.Bit0 n)"
+  "dup (Neg n) = Neg (Num.Bit0 n)"
+  unfolding Pos_def Neg_def neg_numeral_def
+  by (simp_all add: numeral_Bit0)
+
+definition sub :: "num \<Rightarrow> num \<Rightarrow> Target_Numeral.int" where
+  [simp]: "sub m n = numeral m - numeral n"
+
+lemma sub_code [code]:
+  "sub Num.One Num.One = 0"
+  "sub (Num.Bit0 m) Num.One = Pos (Num.BitM m)"
+  "sub (Num.Bit1 m) Num.One = Pos (Num.Bit0 m)"
+  "sub Num.One (Num.Bit0 n) = Neg (Num.BitM n)"
+  "sub Num.One (Num.Bit1 n) = Neg (Num.Bit0 n)"
+  "sub (Num.Bit0 m) (Num.Bit0 n) = dup (sub m n)"
+  "sub (Num.Bit1 m) (Num.Bit1 n) = dup (sub m n)"
+  "sub (Num.Bit1 m) (Num.Bit0 n) = dup (sub m n) + 1"
+  "sub (Num.Bit0 m) (Num.Bit1 n) = dup (sub m n) - 1"
+  unfolding sub_def dup_def numeral.simps Pos_def Neg_def
+    neg_numeral_def numeral_BitM
+  by (simp_all only: algebra_simps add.comm_neutral)
+
+
+text {* Implementations *}
+
+lemma one_int_code [code, code_unfold]:
+  "1 = Pos Num.One"
+  by simp
+
+lemma plus_int_code [code]:
+  "k + 0 = (k::Target_Numeral.int)"
+  "0 + l = (l::Target_Numeral.int)"
+  "Pos m + Pos n = Pos (m + n)"
+  "Pos m + Neg n = sub m n"
+  "Neg m + Pos n = sub n m"
+  "Neg m + Neg n = Neg (m + n)"
+  by simp_all
+
+lemma uminus_int_code [code]:
+  "uminus 0 = (0::Target_Numeral.int)"
+  "uminus (Pos m) = Neg m"
+  "uminus (Neg m) = Pos m"
+  by simp_all
+
+lemma minus_int_code [code]:
+  "k - 0 = (k::Target_Numeral.int)"
+  "0 - l = uminus (l::Target_Numeral.int)"
+  "Pos m - Pos n = sub m n"
+  "Pos m - Neg n = Pos (m + n)"
+  "Neg m - Pos n = Neg (m + n)"
+  "Neg m - Neg n = sub n m"
+  by simp_all
+
+lemma times_int_code [code]:
+  "k * 0 = (0::Target_Numeral.int)"
+  "0 * l = (0::Target_Numeral.int)"
+  "Pos m * Pos n = Pos (m * n)"
+  "Pos m * Neg n = Neg (m * n)"
+  "Neg m * Pos n = Neg (m * n)"
+  "Neg m * Neg n = Pos (m * n)"
+  by simp_all
+
+definition divmod :: "Target_Numeral.int \<Rightarrow> Target_Numeral.int \<Rightarrow> Target_Numeral.int \<times> Target_Numeral.int" where
+  "divmod k l = (k div l, k mod l)"
+
+lemma fst_divmod [simp]:
+  "fst (divmod k l) = k div l"
+  by (simp add: divmod_def)
+
+lemma snd_divmod [simp]:
+  "snd (divmod k l) = k mod l"
+  by (simp add: divmod_def)
+
+definition divmod_abs :: "Target_Numeral.int \<Rightarrow> Target_Numeral.int \<Rightarrow> Target_Numeral.int \<times> Target_Numeral.int" where
+  "divmod_abs k l = (\<bar>k\<bar> div \<bar>l\<bar>, \<bar>k\<bar> mod \<bar>l\<bar>)"
+
+lemma fst_divmod_abs [simp]:
+  "fst (divmod_abs k l) = \<bar>k\<bar> div \<bar>l\<bar>"
+  by (simp add: divmod_abs_def)
+
+lemma snd_divmod_abs [simp]:
+  "snd (divmod_abs k l) = \<bar>k\<bar> mod \<bar>l\<bar>"
+  by (simp add: divmod_abs_def)
+
+lemma divmod_abs_terminate_code [code]:
+  "divmod_abs (Neg k) (Neg l) = divmod_abs (Pos k) (Pos l)"
+  "divmod_abs (Neg k) (Pos l) = divmod_abs (Pos k) (Pos l)"
+  "divmod_abs (Pos k) (Neg l) = divmod_abs (Pos k) (Pos l)"
+  "divmod_abs j 0 = (0, \<bar>j\<bar>)"
+  "divmod_abs 0 j = (0, 0)"
+  by (simp_all add: prod_eq_iff)
+
+lemma divmod_abs_rec_code [code]:
+  "divmod_abs (Pos k) (Pos l) =
+    (let j = sub k l in
+       if j < 0 then (0, Pos k)
+       else let (q, r) = divmod_abs j (Pos l) in (q + 1, r))"
+  by (auto simp add: prod_eq_iff Target_Numeral.int_eq_iff Let_def prod_case_beta
+    sub_non_negative sub_negative div_pos_pos_trivial mod_pos_pos_trivial div_pos_geq mod_pos_geq)
+
+lemma divmod_code [code]: "divmod k l =
+  (if k = 0 then (0, 0) else if l = 0 then (0, k) else
+  (apsnd \<circ> times \<circ> sgn) l (if sgn k = sgn l
+    then divmod_abs k l
+    else (let (r, s) = divmod_abs k l in
+      if s = 0 then (- r, 0) else (- r - 1, \<bar>l\<bar> - s))))"
+proof -
+  have aux1: "\<And>k l::int. sgn k = sgn l \<longleftrightarrow> k = 0 \<and> l = 0 \<or> 0 < l \<and> 0 < k \<or> l < 0 \<and> k < 0"
+    by (auto simp add: sgn_if)
+  have aux2: "\<And>q::int. - int_of k = int_of l * q \<longleftrightarrow> int_of k = int_of l * - q" by auto
+  show ?thesis
+    by (simp add: prod_eq_iff Target_Numeral.int_eq_iff prod_case_beta aux1)
+      (auto simp add: zdiv_zminus1_eq_if zmod_zminus1_eq_if zdiv_zminus2 zmod_zminus2 aux2)
+qed
+
+lemma div_int_code [code]:
+  "k div l = fst (divmod k l)"
+  by simp
+
+lemma div_mod_code [code]:
+  "k mod l = snd (divmod k l)"
+  by simp
+
+lemma equal_int_code [code]:
+  "HOL.equal 0 (0::Target_Numeral.int) \<longleftrightarrow> True"
+  "HOL.equal 0 (Pos l) \<longleftrightarrow> False"
+  "HOL.equal 0 (Neg l) \<longleftrightarrow> False"
+  "HOL.equal (Pos k) 0 \<longleftrightarrow> False"
+  "HOL.equal (Pos k) (Pos l) \<longleftrightarrow> HOL.equal k l"
+  "HOL.equal (Pos k) (Neg l) \<longleftrightarrow> False"
+  "HOL.equal (Neg k) 0 \<longleftrightarrow> False"
+  "HOL.equal (Neg k) (Pos l) \<longleftrightarrow> False"
+  "HOL.equal (Neg k) (Neg l) \<longleftrightarrow> HOL.equal k l"
+  by (simp_all add: equal Target_Numeral.int_eq_iff)
+
+lemma equal_int_refl [code nbe]:
+  "HOL.equal (k::Target_Numeral.int) k \<longleftrightarrow> True"
+  by (fact equal_refl)
+
+lemma less_eq_int_code [code]:
+  "0 \<le> (0::Target_Numeral.int) \<longleftrightarrow> True"
+  "0 \<le> Pos l \<longleftrightarrow> True"
+  "0 \<le> Neg l \<longleftrightarrow> False"
+  "Pos k \<le> 0 \<longleftrightarrow> False"
+  "Pos k \<le> Pos l \<longleftrightarrow> k \<le> l"
+  "Pos k \<le> Neg l \<longleftrightarrow> False"
+  "Neg k \<le> 0 \<longleftrightarrow> True"
+  "Neg k \<le> Pos l \<longleftrightarrow> True"
+  "Neg k \<le> Neg l \<longleftrightarrow> l \<le> k"
+  by (simp_all add: less_eq_int_def)
+
+lemma less_int_code [code]:
+  "0 < (0::Target_Numeral.int) \<longleftrightarrow> False"
+  "0 < Pos l \<longleftrightarrow> True"
+  "0 < Neg l \<longleftrightarrow> False"
+  "Pos k < 0 \<longleftrightarrow> False"
+  "Pos k < Pos l \<longleftrightarrow> k < l"
+  "Pos k < Neg l \<longleftrightarrow> False"
+  "Neg k < 0 \<longleftrightarrow> True"
+  "Neg k < Pos l \<longleftrightarrow> True"
+  "Neg k < Neg l \<longleftrightarrow> l < k"
+  by (simp_all add: less_int_def)
+
+lemma nat_of_code [code]:
+  "nat_of (Neg k) = 0"
+  "nat_of 0 = 0"
+  "nat_of (Pos k) = nat_of_num k"
+  by (simp_all add: nat_of_def nat_of_num_numeral)
+
+lemma int_of_code [code]:
+  "int_of (Neg k) = neg_numeral k"
+  "int_of 0 = 0"
+  "int_of (Pos k) = numeral k"
+  by simp_all
+
+lemma of_int_code [code]:
+  "Target_Numeral.of_int (Int.Neg k) = neg_numeral k"
+  "Target_Numeral.of_int 0 = 0"
+  "Target_Numeral.of_int (Int.Pos k) = numeral k"
+  by simp_all
+
+definition num_of_int :: "Target_Numeral.int \<Rightarrow> num" where
+  "num_of_int = num_of_nat \<circ> nat_of"
+
+lemma num_of_int_code [code]:
+  "num_of_int k = (if k \<le> 1 then Num.One
+     else let
+       (l, j) = divmod k 2;
+       l' = num_of_int l + num_of_int l
+     in if j = 0 then l' else l' + Num.One)"
+proof -
+  {
+    assume "int_of k mod 2 = 1"
+    then have "nat (int_of k mod 2) = nat 1" by simp
+    moreover assume *: "1 < int_of k"
+    ultimately have **: "nat (int_of k) mod 2 = 1" by (simp add: nat_mod_distrib)
+    have "num_of_nat (nat (int_of k)) =
+      num_of_nat (2 * (nat (int_of k) div 2) + nat (int_of k) mod 2)"
+      by simp
+    then have "num_of_nat (nat (int_of k)) =
+      num_of_nat (nat (int_of k) div 2 + nat (int_of k) div 2 + nat (int_of k) mod 2)"
+      by (simp add: nat_mult_2)
+    with ** have "num_of_nat (nat (int_of k)) =
+      num_of_nat (nat (int_of k) div 2 + nat (int_of k) div 2 + 1)"
+      by simp
+  }
+  note aux = this
+  show ?thesis
+    by (auto simp add: num_of_int_def nat_of_def Let_def prod_case_beta
+      not_le Target_Numeral.int_eq_iff less_eq_int_def
+      nat_mult_distrib nat_div_distrib num_of_nat_One num_of_nat_plus_distrib
+       nat_mult_2 aux add_One)
+qed
+
+hide_const (open) int_of nat_of Pos Neg sub dup divmod_abs num_of_int
+
+
+subsection {* Serializer setup for target language numerals *}
+
+code_type Target_Numeral.int
+  (SML "IntInf.int")
+  (OCaml "Big'_int.big'_int")
+  (Haskell "Integer")
+  (Scala "BigInt")
+  (Eval "int")
+
+code_instance Target_Numeral.int :: equal
+  (Haskell -)
+
+code_const "0::Target_Numeral.int"
+  (SML "0")
+  (OCaml "Big'_int.zero'_big'_int")
+  (Haskell "0")
+  (Scala "BigInt(0)")
+
+setup {*
+  fold (Numeral.add_code @{const_name Target_Numeral.Pos}
+    false Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
+*}
+
+setup {*
+  fold (Numeral.add_code @{const_name Target_Numeral.Neg}
+    true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"]
+*}
+
+code_const "plus :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> _"
+  (SML "IntInf.+ ((_), (_))")
+  (OCaml "Big'_int.add'_big'_int")
+  (Haskell infixl 6 "+")
+  (Scala infixl 7 "+")
+  (Eval infixl 8 "+")
+
+code_const "uminus :: Target_Numeral.int \<Rightarrow> _"
+  (SML "IntInf.~")
+  (OCaml "Big'_int.minus'_big'_int")
+  (Haskell "negate")
+  (Scala "!(- _)")
+  (Eval "~/ _")
+
+code_const "minus :: Target_Numeral.int \<Rightarrow> _"
+  (SML "IntInf.- ((_), (_))")
+  (OCaml "Big'_int.sub'_big'_int")
+  (Haskell infixl 6 "-")
+  (Scala infixl 7 "-")
+  (Eval infixl 8 "-")
+
+code_const Target_Numeral.dup
+  (SML "IntInf.*/ (2,/ (_))")
+  (OCaml "Big'_int.mult'_big'_int/ 2")
+  (Haskell "!(2 * _)")
+  (Scala "!(2 * _)")
+  (Eval "!(2 * _)")
+
+code_const Target_Numeral.sub
+  (SML "!(raise/ Fail/ \"sub\")")
+  (OCaml "failwith/ \"sub\"")
+  (Haskell "error/ \"sub\"")
+  (Scala "!error(\"sub\")")
+
+code_const "times :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> _"
+  (SML "IntInf.* ((_), (_))")
+  (OCaml "Big'_int.mult'_big'_int")
+  (Haskell infixl 7 "*")
+  (Scala infixl 8 "*")
+  (Eval infixl 9 "*")
+
+code_const Target_Numeral.divmod_abs
+  (SML "IntInf.divMod/ (IntInf.abs _,/ IntInf.abs _)")
+  (OCaml "Big'_int.quomod'_big'_int/ (Big'_int.abs'_big'_int _)/ (Big'_int.abs'_big'_int _)")
+  (Haskell "divMod/ (abs _)/ (abs _)")
+  (Scala "!((k: BigInt) => (l: BigInt) =>/ if (l == 0)/ (BigInt(0), k) else/ (k.abs '/% l.abs))")
+  (Eval "Integer.div'_mod/ (abs _)/ (abs _)")
+
+code_const "HOL.equal :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> bool"
+  (SML "!((_ : IntInf.int) = _)")
+  (OCaml "Big'_int.eq'_big'_int")
+  (Haskell infix 4 "==")
+  (Scala infixl 5 "==")
+  (Eval infixl 6 "=")
+
+code_const "less_eq :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> bool"
+  (SML "IntInf.<= ((_), (_))")
+  (OCaml "Big'_int.le'_big'_int")
+  (Haskell infix 4 "<=")
+  (Scala infixl 4 "<=")
+  (Eval infixl 6 "<=")
+
+code_const "less :: Target_Numeral.int \<Rightarrow> _ \<Rightarrow> bool"
+  (SML "IntInf.< ((_), (_))")
+  (OCaml "Big'_int.lt'_big'_int")
+  (Haskell infix 4 "<")
+  (Scala infixl 4 "<")
+  (Eval infixl 6 "<")
+
+ML {*
+structure Target_Numeral =
+struct
+
+val T = @{typ "Target_Numeral.int"};
+
+end;
+*}
+
+code_reserved Eval Target_Numeral
+
+code_const "Code_Evaluation.term_of \<Colon> Target_Numeral.int \<Rightarrow> term"
+  (Eval "HOLogic.mk'_number/ Target'_Numeral.T")
+
+code_modulename SML
+  Target_Numeral Arith
+
+code_modulename OCaml
+  Target_Numeral Arith
+
+code_modulename Haskell
+  Target_Numeral Arith
+
+
+subsection {* Implementation for @{typ int} *}
+
+code_datatype Target_Numeral.int_of
+
+lemma [code, code del]:
+  "Target_Numeral.of_int = Target_Numeral.of_int" ..
+
+lemma [code]:
+  "Target_Numeral.of_int (Target_Numeral.int_of k) = k"
+  by (simp add: Target_Numeral.int_eq_iff)
+
+declare Int.Pos_def [code]
+
+lemma [code_abbrev]:
+  "Target_Numeral.int_of (Target_Numeral.Pos k) = Int.Pos k"
+  by simp
+
+declare Int.Neg_def [code]
+
+lemma [code_abbrev]:
+  "Target_Numeral.int_of (Target_Numeral.Neg k) = Int.Neg k"
+  by simp
+
+lemma [code]:
+  "0 = Target_Numeral.int_of 0"
+  by simp
+
+lemma [code]:
+  "1 = Target_Numeral.int_of 1"
+  by simp
+
+lemma [code]:
+  "k + l = Target_Numeral.int_of (of_int k + of_int l)"
+  by simp
+
+lemma [code]:
+  "- k = Target_Numeral.int_of (- of_int k)"
+  by simp
+
+lemma [code]:
+  "k - l = Target_Numeral.int_of (of_int k - of_int l)"
+  by simp
+
+lemma [code]:
+  "Int.dup k = Target_Numeral.int_of (Target_Numeral.dup (of_int k))"
+  by simp
+
+lemma [code, code del]:
+  "Int.sub = Int.sub" ..
+
+lemma [code]:
+  "k * l = Target_Numeral.int_of (of_int k * of_int l)"
+  by simp
+
+lemma [code]:
+  "pdivmod k l = map_pair Target_Numeral.int_of Target_Numeral.int_of
+    (Target_Numeral.divmod_abs (of_int k) (of_int l))"
+  by (simp add: prod_eq_iff pdivmod_def)
+
+lemma [code]:
+  "k div l = Target_Numeral.int_of (of_int k div of_int l)"
+  by simp
+
+lemma [code]:
+  "k mod l = Target_Numeral.int_of (of_int k mod of_int l)"
+  by simp
+
+lemma [code]:
+  "HOL.equal k l = HOL.equal (of_int k :: Target_Numeral.int) (of_int l)"
+  by (simp add: equal Target_Numeral.int_eq_iff)
+
+lemma [code]:
+  "k \<le> l \<longleftrightarrow> (of_int k :: Target_Numeral.int) \<le> of_int l"
+  by (simp add: less_eq_int_def)
+
+lemma [code]:
+  "k < l \<longleftrightarrow> (of_int k :: Target_Numeral.int) < of_int l"
+  by (simp add: less_int_def)
+
+lemma (in ring_1) of_int_code:
+  "of_int k = (if k = 0 then 0
+     else if k < 0 then - of_int (- k)
+     else let
+       (l, j) = divmod_int k 2;
+       l' = 2 * of_int l
+     in if j = 0 then l' else l' + 1)"
+proof -
+  from mod_div_equality have *: "of_int k = of_int (k div 2 * 2 + k mod 2)" by simp
+  show ?thesis
+    by (simp add: Let_def divmod_int_mod_div mod_2_not_eq_zero_eq_one_int
+      of_int_add [symmetric]) (simp add: * mult_commute)
+qed
+
+declare of_int_code [code]
+
+
+subsection {* Implementation for @{typ nat} *}
+
+definition of_nat :: "nat \<Rightarrow> Target_Numeral.int" where
+  [code_abbrev]: "of_nat = Nat.of_nat"
+
+hide_const (open) of_nat
+
+lemma int_of_nat [simp]:
+  "Target_Numeral.int_of (Target_Numeral.of_nat n) = of_nat n"
+  by (simp add: of_nat_def)
+
+lemma [code abstype]:
+  "Target_Numeral.nat_of (Target_Numeral.of_nat n) = n"
+  by (simp add: nat_of_def)
+
+lemma [code_abbrev]:
+  "nat (Int.Pos k) = nat_of_num k"
+  by (simp add: nat_of_num_numeral)
+
+lemma [code abstract]:
+  "Target_Numeral.of_nat 0 = 0"
+  by (simp add: Target_Numeral.int_eq_iff)
+
+lemma [code abstract]:
+  "Target_Numeral.of_nat 1 = 1"
+  by (simp add: Target_Numeral.int_eq_iff)
+
+lemma [code abstract]:
+  "Target_Numeral.of_nat (m + n) = of_nat m + of_nat n"
+  by (simp add: Target_Numeral.int_eq_iff)
+
+lemma [code abstract]:
+  "Target_Numeral.of_nat (Code_Nat.dup n) = Target_Numeral.dup (of_nat n)"
+  by (simp add: Target_Numeral.int_eq_iff Code_Nat.dup_def)
+
+lemma [code, code del]:
+  "Code_Nat.sub = Code_Nat.sub" ..
+
+lemma [code abstract]:
+  "Target_Numeral.of_nat (m - n) = max 0 (of_nat m - of_nat n)"
+  by (simp add: Target_Numeral.int_eq_iff)
+
+lemma [code abstract]:
+  "Target_Numeral.of_nat (m * n) = of_nat m * of_nat n"
+  by (simp add: Target_Numeral.int_eq_iff of_nat_mult)
+
+lemma [code abstract]:
+  "Target_Numeral.of_nat (m div n) = of_nat m div of_nat n"
+  by (simp add: Target_Numeral.int_eq_iff zdiv_int)
+
+lemma [code abstract]:
+  "Target_Numeral.of_nat (m mod n) = of_nat m mod of_nat n"
+  by (simp add: Target_Numeral.int_eq_iff zmod_int)
+
+lemma [code]:
+  "Divides.divmod_nat m n = (m div n, m mod n)"
+  by (simp add: prod_eq_iff)
+
+lemma [code]:
+  "HOL.equal m n = HOL.equal (of_nat m :: Target_Numeral.int) (of_nat n)"
+  by (simp add: equal Target_Numeral.int_eq_iff)
+
+lemma [code]:
+  "m \<le> n \<longleftrightarrow> (of_nat m :: Target_Numeral.int) \<le> of_nat n"
+  by (simp add: less_eq_int_def)
+
+lemma [code]:
+  "m < n \<longleftrightarrow> (of_nat m :: Target_Numeral.int) < of_nat n"
+  by (simp add: less_int_def)
+
+lemma num_of_nat_code [code]:
+  "num_of_nat = Target_Numeral.num_of_int \<circ> Target_Numeral.of_nat"
+  by (simp add: fun_eq_iff num_of_int_def of_nat_def)
+
+lemma (in semiring_1) of_nat_code:
+  "of_nat n = (if n = 0 then 0
+     else let
+       (m, q) = divmod_nat n 2;
+       m' = 2 * of_nat m
+     in if q = 0 then m' else m' + 1)"
+proof -
+  from mod_div_equality have *: "of_nat n = of_nat (n div 2 * 2 + n mod 2)" by simp
+  show ?thesis
+    by (simp add: Let_def divmod_nat_div_mod mod_2_not_eq_zero_eq_one_nat
+      of_nat_add [symmetric])
+      (simp add: * mult_commute of_nat_mult add_commute)
+qed
+
+declare of_nat_code [code]
+
+text {* Conversions between @{typ nat} and @{typ int} *}
+
+definition int :: "nat \<Rightarrow> int" where
+  [code_abbrev]: "int = of_nat"
+
+hide_const (open) int
+
+lemma [code]:
+  "Target_Numeral.int n = Target_Numeral.int_of (of_nat n)"
+  by (simp add: int_def)
+
+lemma [code abstract]:
+  "Target_Numeral.of_nat (nat k) = max 0 (Target_Numeral.of_int k)"
+  by (simp add: of_nat_def of_int_of_nat max_def)
+
+end
--- a/src/HOL/List.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/List.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -2676,7 +2676,7 @@
 -- {* simp does not terminate! *}
 by (induct j) auto
 
-lemmas upt_rec_number_of[simp] = upt_rec[of "number_of m" "number_of n"] for m n
+lemmas upt_rec_numeral[simp] = upt_rec[of "numeral m" "numeral n"] for m n
 
 lemma upt_conv_Nil [simp]: "j <= i ==> [i..<j] = []"
 by (subst upt_rec) simp
@@ -2791,13 +2791,17 @@
 lemma nth_Cons': "(x # xs)!n = (if n = 0 then x else xs!(n - 1))"
 by (cases n) simp_all
 
-lemmas take_Cons_number_of = take_Cons'[of "number_of v"] for v
-lemmas drop_Cons_number_of = drop_Cons'[of "number_of v"] for v
-lemmas nth_Cons_number_of = nth_Cons'[of _ _ "number_of v"] for v
-
-declare take_Cons_number_of [simp] 
-        drop_Cons_number_of [simp] 
-        nth_Cons_number_of [simp] 
+lemma take_Cons_numeral [simp]:
+  "take (numeral v) (x # xs) = x # take (numeral v - 1) xs"
+by (simp add: take_Cons')
+
+lemma drop_Cons_numeral [simp]:
+  "drop (numeral v) (x # xs) = drop (numeral v - 1) xs"
+by (simp add: drop_Cons')
+
+lemma nth_Cons_numeral [simp]:
+  "(x # xs) ! numeral v = xs ! (numeral v - 1)"
+by (simp add: nth_Cons')
 
 
 subsubsection {* @{text upto}: interval-list on @{typ int} *}
@@ -2812,7 +2816,11 @@
 
 declare upto.simps[code, simp del]
 
-lemmas upto_rec_number_of[simp] = upto.simps[of "number_of m" "number_of n"] for m n
+lemmas upto_rec_numeral [simp] =
+  upto.simps[of "numeral m" "numeral n"]
+  upto.simps[of "numeral m" "neg_numeral n"]
+  upto.simps[of "neg_numeral m" "numeral n"]
+  upto.simps[of "neg_numeral m" "neg_numeral n"] for m n
 
 lemma upto_empty[simp]: "j < i \<Longrightarrow> [i..j] = []"
 by(simp add: upto.simps)
--- a/src/HOL/Matrix_LP/ComputeFloat.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Matrix_LP/ComputeFloat.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -75,8 +75,11 @@
   ultimately show ?thesis by auto
 qed
 
-lemma real_is_int_number_of[simp]: "real_is_int ((number_of \<Colon> int \<Rightarrow> real) x)"
-  by (auto simp: real_is_int_def intro!: exI[of _ "number_of x"])
+lemma real_is_int_numeral[simp]: "real_is_int (numeral x)"
+  by (auto simp: real_is_int_def intro!: exI[of _ "numeral x"])
+
+lemma real_is_int_neg_numeral[simp]: "real_is_int (neg_numeral x)"
+  by (auto simp: real_is_int_def intro!: exI[of _ "neg_numeral x"])
 
 lemma int_of_real_0[simp]: "int_of_real (0::real) = (0::int)"
 by (simp add: int_of_real_def)
@@ -87,7 +90,12 @@
   show ?thesis by (simp only: 1 int_of_real_real)
 qed
 
-lemma int_of_real_number_of[simp]: "int_of_real (number_of b) = number_of b"
+lemma int_of_real_numeral[simp]: "int_of_real (numeral b) = numeral b"
+  unfolding int_of_real_def
+  by (intro some_equality)
+     (auto simp add: real_of_int_inject[symmetric] simp del: real_of_int_inject)
+
+lemma int_of_real_neg_numeral[simp]: "int_of_real (neg_numeral b) = neg_numeral b"
   unfolding int_of_real_def
   by (intro some_equality)
      (auto simp add: real_of_int_inject[symmetric] simp del: real_of_int_inject)
@@ -101,7 +109,7 @@
 lemma abs_div_2_less: "a \<noteq> 0 \<Longrightarrow> a \<noteq> -1 \<Longrightarrow> abs((a::int) div 2) < abs a"
 by arith
 
-lemma norm_0_1: "(0::_::number_ring) = Numeral0 & (1::_::number_ring) = Numeral1"
+lemma norm_0_1: "(1::_::numeral) = Numeral1"
   by auto
 
 lemma add_left_zero: "0 + a = (a::'a::comm_monoid_add)"
@@ -116,34 +124,21 @@
 lemma mult_right_one: "a * 1 = (a::'a::semiring_1)"
   by simp
 
-lemma int_pow_0: "(a::int)^(Numeral0) = 1"
+lemma int_pow_0: "(a::int)^0 = 1"
   by simp
 
 lemma int_pow_1: "(a::int)^(Numeral1) = a"
   by simp
 
-lemma zero_eq_Numeral0_nring: "(0::'a::number_ring) = Numeral0"
-  by simp
-
-lemma one_eq_Numeral1_nring: "(1::'a::number_ring) = Numeral1"
-  by simp
-
-lemma zero_eq_Numeral0_nat: "(0::nat) = Numeral0"
+lemma one_eq_Numeral1_nring: "(1::'a::numeral) = Numeral1"
   by simp
 
 lemma one_eq_Numeral1_nat: "(1::nat) = Numeral1"
   by simp
 
-lemma zpower_Pls: "(z::int)^Numeral0 = Numeral1"
+lemma zpower_Pls: "(z::int)^0 = Numeral1"
   by simp
 
-lemma zpower_Min: "(z::int)^((-1)::nat) = Numeral1"
-proof -
-  have 1:"((-1)::nat) = 0"
-    by simp
-  show ?thesis by (simp add: 1)
-qed
-
 lemma fst_cong: "a=a' \<Longrightarrow> fst (a,b) = fst (a',b)"
   by simp
 
@@ -160,70 +155,8 @@
 
 lemma not_true_eq_false: "(~ True) = False" by simp
 
-lemmas binarith =
-  normalize_bin_simps
-  pred_bin_simps succ_bin_simps
-  add_bin_simps minus_bin_simps mult_bin_simps
-
-lemma int_eq_number_of_eq:
-  "(((number_of v)::int)=(number_of w)) = iszero ((number_of (v + uminus w))::int)"
-  by (rule eq_number_of_eq)
-
-lemma int_iszero_number_of_Pls: "iszero (Numeral0::int)"
-  by (simp only: iszero_number_of_Pls)
-
-lemma int_nonzero_number_of_Min: "~(iszero ((-1)::int))"
-  by simp
-
-lemma int_iszero_number_of_Bit0: "iszero ((number_of (Int.Bit0 w))::int) = iszero ((number_of w)::int)"
-  by simp
-
-lemma int_iszero_number_of_Bit1: "\<not> iszero ((number_of (Int.Bit1 w))::int)"
-  by simp
-
-lemma int_less_number_of_eq_neg: "(((number_of x)::int) < number_of y) = neg ((number_of (x + (uminus y)))::int)"
-  unfolding neg_def number_of_is_id by simp
-
-lemma int_not_neg_number_of_Pls: "\<not> (neg (Numeral0::int))"
-  by simp
-
-lemma int_neg_number_of_Min: "neg (-1::int)"
-  by simp
-
-lemma int_neg_number_of_Bit0: "neg ((number_of (Int.Bit0 w))::int) = neg ((number_of w)::int)"
-  by simp
-
-lemma int_neg_number_of_Bit1: "neg ((number_of (Int.Bit1 w))::int) = neg ((number_of w)::int)"
-  by simp
-
-lemma int_le_number_of_eq: "(((number_of x)::int) \<le> number_of y) = (\<not> neg ((number_of (y + (uminus x)))::int))"
-  unfolding neg_def number_of_is_id by (simp add: not_less)
-
-lemmas intarithrel =
-  int_eq_number_of_eq
-  lift_bool[OF int_iszero_number_of_Pls] nlift_bool[OF int_nonzero_number_of_Min] int_iszero_number_of_Bit0
-  lift_bool[OF int_iszero_number_of_Bit1] int_less_number_of_eq_neg nlift_bool[OF int_not_neg_number_of_Pls] lift_bool[OF int_neg_number_of_Min]
-  int_neg_number_of_Bit0 int_neg_number_of_Bit1 int_le_number_of_eq
-
-lemma int_number_of_add_sym: "((number_of v)::int) + number_of w = number_of (v + w)"
-  by simp
-
-lemma int_number_of_diff_sym: "((number_of v)::int) - number_of w = number_of (v + (uminus w))"
-  by simp
-
-lemma int_number_of_mult_sym: "((number_of v)::int) * number_of w = number_of (v * w)"
-  by simp
-
-lemma int_number_of_minus_sym: "- ((number_of v)::int) = number_of (uminus v)"
-  by simp
-
-lemmas intarith = int_number_of_add_sym int_number_of_minus_sym int_number_of_diff_sym int_number_of_mult_sym
-
-lemmas natarith = add_nat_number_of diff_nat_number_of mult_nat_number_of eq_nat_number_of less_nat_number_of
-
-lemmas powerarith = nat_number_of zpower_number_of_even
-  zpower_number_of_odd[simplified zero_eq_Numeral0_nring one_eq_Numeral1_nring]
-  zpower_Pls zpower_Min
+lemmas powerarith = nat_numeral zpower_numeral_even
+  zpower_numeral_odd zpower_Pls
 
 definition float :: "(int \<times> int) \<Rightarrow> real" where
   "float = (\<lambda>(a, b). real a * 2 powr real b)"
@@ -302,7 +235,8 @@
           float_minus float_abs zero_le_float float_pprt float_nprt pprt_lbound nprt_ubound
 
 (* for use with the compute oracle *)
-lemmas arith = binarith intarith intarithrel natarith powerarith floatarith not_false_eq_true not_true_eq_false
+lemmas arith = arith_simps rel_simps diff_nat_numeral nat_0
+  nat_neg_numeral powerarith floatarith not_false_eq_true not_true_eq_false
 
 use "~~/src/HOL/Tools/float_arith.ML"
 
--- a/src/HOL/Matrix_LP/ComputeNumeral.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Matrix_LP/ComputeNumeral.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -2,145 +2,47 @@
 imports ComputeHOL ComputeFloat
 begin
 
-(* normalization of bit strings *)
-lemmas bitnorm = normalize_bin_simps
-
-(* neg for bit strings *)
-lemma neg1: "neg Int.Pls = False" by (simp add: Int.Pls_def)
-lemma neg2: "neg Int.Min = True" apply (subst Int.Min_def) by auto
-lemma neg3: "neg (Int.Bit0 x) = neg x" apply (simp add: neg_def) apply (subst Bit0_def) by auto
-lemma neg4: "neg (Int.Bit1 x) = neg x" apply (simp add: neg_def) apply (subst Bit1_def) by auto  
-lemmas bitneg = neg1 neg2 neg3 neg4
-
-(* iszero for bit strings *)
-lemma iszero1: "iszero Int.Pls = True" by (simp add: Int.Pls_def iszero_def)
-lemma iszero2: "iszero Int.Min = False" apply (subst Int.Min_def) apply (subst iszero_def) by simp
-lemma iszero3: "iszero (Int.Bit0 x) = iszero x" apply (subst Int.Bit0_def) apply (subst iszero_def)+ by auto
-lemma iszero4: "iszero (Int.Bit1 x) = False" apply (subst Int.Bit1_def) apply (subst iszero_def)+  apply simp by arith
-lemmas bitiszero = iszero1 iszero2 iszero3 iszero4
-
-(* lezero for bit strings *)
-definition "lezero x \<longleftrightarrow> x \<le> 0"
-lemma lezero1: "lezero Int.Pls = True" unfolding Int.Pls_def lezero_def by auto
-lemma lezero2: "lezero Int.Min = True" unfolding Int.Min_def lezero_def by auto
-lemma lezero3: "lezero (Int.Bit0 x) = lezero x" unfolding Int.Bit0_def lezero_def by auto
-lemma lezero4: "lezero (Int.Bit1 x) = neg x" unfolding Int.Bit1_def lezero_def neg_def by auto
-lemmas bitlezero = lezero1 lezero2 lezero3 lezero4
-
 (* equality for bit strings *)
-lemmas biteq = eq_bin_simps
+lemmas biteq = eq_num_simps
 
 (* x < y for bit strings *)
-lemmas bitless = less_bin_simps
+lemmas bitless = less_num_simps
 
 (* x \<le> y for bit strings *)
-lemmas bitle = le_bin_simps
-
-(* succ for bit strings *)
-lemmas bitsucc = succ_bin_simps
-
-(* pred for bit strings *)
-lemmas bitpred = pred_bin_simps
-
-(* unary minus for bit strings *)
-lemmas bituminus = minus_bin_simps
+lemmas bitle = le_num_simps
 
 (* addition for bit strings *)
-lemmas bitadd = add_bin_simps
+lemmas bitadd = add_num_simps
 
 (* multiplication for bit strings *) 
-lemma mult_Pls_right: "x * Int.Pls = Int.Pls" by (simp add: Pls_def)
-lemma mult_Min_right: "x * Int.Min = - x" by (subst mult_commute) simp 
-lemma multb0x: "(Int.Bit0 x) * y = Int.Bit0 (x * y)" by (rule mult_Bit0)
-lemma multxb0: "x * (Int.Bit0 y) = Int.Bit0 (x * y)" unfolding Bit0_def by simp
-lemma multb1: "(Int.Bit1 x) * (Int.Bit1 y) = Int.Bit1 (Int.Bit0 (x * y) + x + y)"
-  unfolding Bit0_def Bit1_def by (simp add: algebra_simps)
-lemmas bitmul = mult_Pls mult_Min mult_Pls_right mult_Min_right multb0x multxb0 multb1
+lemmas bitmul = mult_num_simps
 
-lemmas bitarith = bitnorm bitiszero bitneg bitlezero biteq bitless bitle bitsucc bitpred bituminus bitadd bitmul 
-
-definition "nat_norm_number_of (x::nat) = x"
-
-lemma nat_norm_number_of: "nat_norm_number_of (number_of w) = (if lezero w then 0 else number_of w)"
-  apply (simp add: nat_norm_number_of_def)
-  unfolding lezero_def iszero_def neg_def
-  apply (simp add: numeral_simps)
-  done
+lemmas bitarith = arith_simps
 
 (* Normalization of nat literals *)
-lemma natnorm0: "(0::nat) = number_of (Int.Pls)" by auto
-lemma natnorm1: "(1 :: nat) = number_of (Int.Bit1 Int.Pls)"  by auto 
-lemmas natnorm = natnorm0 natnorm1 nat_norm_number_of
-
-(* Suc *)
-lemma natsuc: "Suc (number_of x) = (if neg x then 1 else number_of (Int.succ x))" by (auto simp add: number_of_is_id)
-
-(* Addition for nat *)
-lemma natadd: "number_of x + ((number_of y)::nat) = (if neg x then (number_of y) else (if neg y then number_of x else (number_of (x + y))))"
-  unfolding nat_number_of_def number_of_is_id neg_def
-  by auto
-
-(* Subtraction for nat *)
-lemma natsub: "(number_of x) - ((number_of y)::nat) = 
-  (if neg x then 0 else (if neg y then number_of x else (nat_norm_number_of (number_of (x + (- y))))))"
-  unfolding nat_norm_number_of
-  by (auto simp add: number_of_is_id neg_def lezero_def iszero_def Let_def nat_number_of_def)
-
-(* Multiplication for nat *)
-lemma natmul: "(number_of x) * ((number_of y)::nat) = 
-  (if neg x then 0 else (if neg y then 0 else number_of (x * y)))"
-  unfolding nat_number_of_def number_of_is_id neg_def
-  by (simp add: nat_mult_distrib)
-
-lemma nateq: "(((number_of x)::nat) = (number_of y)) = ((lezero x \<and> lezero y) \<or> (x = y))"
-  by (auto simp add: iszero_def lezero_def neg_def number_of_is_id)
-
-lemma natless: "(((number_of x)::nat) < (number_of y)) = ((x < y) \<and> (\<not> (lezero y)))"
-  by (simp add: lezero_def numeral_simps not_le)
-
-lemma natle: "(((number_of x)::nat) \<le> (number_of y)) = (y < x \<longrightarrow> lezero x)"
-  by (auto simp add: number_of_is_id lezero_def nat_number_of_def)
+lemmas natnorm = one_eq_Numeral1_nat
 
 fun natfac :: "nat \<Rightarrow> nat"
   where "natfac n = (if n = 0 then 1 else n * (natfac (n - 1)))"
 
-lemmas compute_natarith = bitarith natnorm natsuc natadd natsub natmul nateq natless natle natfac.simps
-
-lemma number_eq: "(((number_of x)::'a::{number_ring, linordered_idom}) = (number_of y)) = (x = y)"
-  unfolding number_of_eq
-  apply simp
-  done
+lemmas compute_natarith =
+  arith_simps rel_simps
+  diff_nat_numeral nat_numeral nat_0 nat_neg_numeral
+  numeral_1_eq_1 [symmetric]
+  numeral_1_eq_Suc_0 [symmetric]
+  Suc_numeral natfac.simps
 
-lemma number_le: "(((number_of x)::'a::{number_ring, linordered_idom}) \<le>  (number_of y)) = (x \<le> y)"
-  unfolding number_of_eq
-  apply simp
-  done
-
-lemma number_less: "(((number_of x)::'a::{number_ring, linordered_idom}) <  (number_of y)) = (x < y)"
-  unfolding number_of_eq 
-  apply simp
-  done
+lemmas number_norm = numeral_1_eq_1[symmetric]
 
-lemma number_diff: "((number_of x)::'a::{number_ring, linordered_idom}) - number_of y = number_of (x + (- y))"
-  apply (subst diff_number_of_eq)
-  apply simp
-  done
-
-lemmas number_norm = number_of_Pls[symmetric] numeral_1_eq_1[symmetric]
-
-lemmas compute_numberarith = number_of_minus[symmetric] number_of_add[symmetric] number_diff number_of_mult[symmetric] number_norm number_eq number_le number_less
+lemmas compute_numberarith =
+  arith_simps rel_simps number_norm
 
-lemma compute_real_of_nat_number_of: "real ((number_of v)::nat) = (if neg v then 0 else number_of v)"
-  by (simp only: real_of_nat_number_of number_of_is_id)
-
-lemma compute_nat_of_int_number_of: "nat ((number_of v)::int) = (number_of v)"
-  by simp
+lemmas compute_num_conversions =
+  real_of_nat_numeral real_of_nat_zero
+  nat_numeral nat_0 nat_neg_numeral
+  real_numeral real_of_int_zero
 
-lemmas compute_num_conversions = compute_real_of_nat_number_of compute_nat_of_int_number_of real_number_of
-
-lemmas zpowerarith = zpower_number_of_even
-  zpower_number_of_odd[simplified zero_eq_Numeral0_nring one_eq_Numeral1_nring]
-  zpower_Pls zpower_Min
+lemmas zpowerarith = zpower_numeral_even zpower_numeral_odd zpower_Pls int_pow_1
 
 (* div, mod *)
 
@@ -162,26 +64,19 @@
 
 (* collecting all the theorems *)
 
-lemma even_Pls: "even (Int.Pls) = True"
-  apply (unfold Pls_def even_def)
+lemma even_0_int: "even (0::int) = True"
   by simp
 
-lemma even_Min: "even (Int.Min) = False"
-  apply (unfold Min_def even_def)
+lemma even_One_int: "even (numeral Num.One :: int) = False"
   by simp
 
-lemma even_B0: "even (Int.Bit0 x) = True"
-  apply (unfold Bit0_def)
+lemma even_Bit0_int: "even (numeral (Num.Bit0 x) :: int) = True"
   by simp
 
-lemma even_B1: "even (Int.Bit1 x) = False"
-  apply (unfold Bit1_def)
+lemma even_Bit1_int: "even (numeral (Num.Bit1 x) :: int) = False"
   by simp
 
-lemma even_number_of: "even ((number_of w)::int) = even w"
-  by (simp only: number_of_is_id)
-
-lemmas compute_even = even_Pls even_Min even_B0 even_B1 even_number_of
+lemmas compute_even = even_0_int even_One_int even_Bit0_int even_Bit1_int
 
 lemmas compute_numeral = compute_if compute_let compute_pair compute_bool 
                          compute_natarith compute_numberarith max_def min_def compute_num_conversions zpowerarith compute_div_mod compute_even
--- a/src/HOL/Matrix_LP/SparseMatrix.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Matrix_LP/SparseMatrix.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -1029,9 +1029,7 @@
   sparse_row_matrix_pprt sorted_spvec_pprt_spmat sorted_spmat_pprt_spmat
   sparse_row_matrix_nprt sorted_spvec_nprt_spmat sorted_spmat_nprt_spmat
 
-lemma zero_eq_Numeral0: "(0::_::number_ring) = Numeral0" by simp
-
-lemmas sparse_row_matrix_arith_simps[simplified zero_eq_Numeral0] = 
+lemmas sparse_row_matrix_arith_simps = 
   mult_spmat.simps mult_spvec_spmat.simps 
   addmult_spvec.simps 
   smult_spvec_empty smult_spvec_cons
--- a/src/HOL/Metis_Examples/Big_O.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Metis_Examples/Big_O.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -16,7 +16,7 @@
 
 subsection {* Definitions *}
 
-definition bigo :: "('a => 'b\<Colon>{linordered_idom,number_ring}) => ('a => 'b) set" ("(1O'(_'))") where
+definition bigo :: "('a => 'b\<Colon>linordered_idom) => ('a => 'b) set" ("(1O'(_'))") where
   "O(f\<Colon>('a => 'b)) == {h. \<exists>c. \<forall>x. abs (h x) <= c * abs (f x)}"
 
 lemma bigo_pos_const:
@@ -180,7 +180,7 @@
  apply (rule_tac x = "c + c" in exI)
  apply auto
  apply (subgoal_tac "c * abs (f xa + g xa) <= (c + c) * abs (g xa)")
-  apply (metis order_trans semiring_mult_2)
+  apply (metis order_trans mult_2)
  apply (subgoal_tac "c * abs (f xa + g xa) <= c * (abs (f xa) + abs (g xa))")
   apply (erule order_trans)
   apply (simp add: ring_distribs)
@@ -325,7 +325,7 @@
 by (metis bigo_mult2 set_plus_mono_b set_times_intro2 set_times_plus_distrib)
 
 lemma bigo_mult5: "\<forall>x. f x ~= 0 \<Longrightarrow>
-    O(f * g) <= (f\<Colon>'a => ('b\<Colon>{linordered_field,number_ring})) *o O(g)"
+    O(f * g) <= (f\<Colon>'a => ('b\<Colon>linordered_field)) *o O(g)"
 proof -
   assume a: "\<forall>x. f x ~= 0"
   show "O(f * g) <= f *o O(g)"
@@ -351,21 +351,21 @@
 qed
 
 lemma bigo_mult6:
-"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = (f\<Colon>'a \<Rightarrow> ('b\<Colon>{linordered_field,number_ring})) *o O(g)"
+"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = (f\<Colon>'a \<Rightarrow> ('b\<Colon>linordered_field)) *o O(g)"
 by (metis bigo_mult2 bigo_mult5 order_antisym)
 
 (*proof requires relaxing relevance: 2007-01-25*)
 declare bigo_mult6 [simp]
 
 lemma bigo_mult7:
-"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) \<le> O(f\<Colon>'a \<Rightarrow> ('b\<Colon>{linordered_field,number_ring})) \<otimes> O(g)"
+"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) \<le> O(f\<Colon>'a \<Rightarrow> ('b\<Colon>linordered_field)) \<otimes> O(g)"
 by (metis bigo_refl bigo_mult6 set_times_mono3)
 
 declare bigo_mult6 [simp del]
 declare bigo_mult7 [intro!]
 
 lemma bigo_mult8:
-"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = O(f\<Colon>'a \<Rightarrow> ('b\<Colon>{linordered_field,number_ring})) \<otimes> O(g)"
+"\<forall>x. f x \<noteq> 0 \<Longrightarrow> O(f * g) = O(f\<Colon>'a \<Rightarrow> ('b\<Colon>linordered_field)) \<otimes> O(g)"
 by (metis bigo_mult bigo_mult7 order_antisym_conv)
 
 lemma bigo_minus [intro]: "f : O(g) \<Longrightarrow> - f : O(g)"
@@ -405,14 +405,14 @@
 lemma bigo_const2 [intro]: "O(\<lambda>x. c) \<le> O(\<lambda>x. 1)"
 by (metis bigo_const1 bigo_elt_subset)
 
-lemma bigo_const3: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow> (\<lambda>x. 1) : O(\<lambda>x. c)"
+lemma bigo_const3: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow> (\<lambda>x. 1) : O(\<lambda>x. c)"
 apply (simp add: bigo_def)
 by (metis abs_eq_0 left_inverse order_refl)
 
-lemma bigo_const4: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow> O(\<lambda>x. 1) <= O(\<lambda>x. c)"
+lemma bigo_const4: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow> O(\<lambda>x. 1) <= O(\<lambda>x. c)"
 by (metis bigo_elt_subset bigo_const3)
 
-lemma bigo_const [simp]: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
+lemma bigo_const [simp]: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
     O(\<lambda>x. c) = O(\<lambda>x. 1)"
 by (metis bigo_const2 bigo_const4 equalityI)
 
@@ -423,19 +423,19 @@
 lemma bigo_const_mult2: "O(\<lambda>x. c * f x) \<le> O(f)"
 by (rule bigo_elt_subset, rule bigo_const_mult1)
 
-lemma bigo_const_mult3: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow> f : O(\<lambda>x. c * f x)"
+lemma bigo_const_mult3: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow> f : O(\<lambda>x. c * f x)"
 apply (simp add: bigo_def)
 by (metis (no_types) abs_mult mult_assoc mult_1 order_refl left_inverse)
 
 lemma bigo_const_mult4:
-"(c\<Colon>'a\<Colon>{linordered_field,number_ring}) \<noteq> 0 \<Longrightarrow> O(f) \<le> O(\<lambda>x. c * f x)"
+"(c\<Colon>'a\<Colon>linordered_field) \<noteq> 0 \<Longrightarrow> O(f) \<le> O(\<lambda>x. c * f x)"
 by (metis bigo_elt_subset bigo_const_mult3)
 
-lemma bigo_const_mult [simp]: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
+lemma bigo_const_mult [simp]: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
     O(\<lambda>x. c * f x) = O(f)"
 by (metis equalityI bigo_const_mult2 bigo_const_mult4)
 
-lemma bigo_const_mult5 [simp]: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
+lemma bigo_const_mult5 [simp]: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
     (\<lambda>x. c) *o O(f) = O(f)"
   apply (auto del: subsetI)
   apply (rule order_trans)
@@ -587,7 +587,7 @@
   apply assumption+
 done
 
-lemma bigo_useful_const_mult: "(c\<Colon>'a\<Colon>{linordered_field,number_ring}) ~= 0 \<Longrightarrow>
+lemma bigo_useful_const_mult: "(c\<Colon>'a\<Colon>linordered_field) ~= 0 \<Longrightarrow>
     (\<lambda>x. c) * f =o O(h) \<Longrightarrow> f =o O(h)"
   apply (rule subsetD)
   apply (subgoal_tac "(\<lambda>x. 1 / c) *o O(h) <= O(h)")
@@ -696,7 +696,7 @@
 by (metis abs_ge_zero linorder_linear min_max.sup_absorb1 min_max.sup_commute)
 
 lemma bigo_lesso4:
-  "f <o g =o O(k\<Colon>'a=>'b\<Colon>{linordered_field,number_ring}) \<Longrightarrow>
+  "f <o g =o O(k\<Colon>'a=>'b\<Colon>{linordered_field}) \<Longrightarrow>
    g =o h +o O(k) \<Longrightarrow> f <o h =o O(k)"
 apply (unfold lesso_def)
 apply (drule set_plus_imp_minus)
--- a/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Multivariate_Analysis/Cartesian_Euclidean_Space.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -207,6 +207,15 @@
     by (auto intro!: injI simp add: vec_eq_iff of_nat_index)
 qed
 
+instance vec :: (numeral, finite) numeral ..
+instance vec :: (semiring_numeral, finite) semiring_numeral ..
+
+lemma numeral_index [simp]: "numeral w $ i = numeral w"
+  by (induct w, simp_all only: numeral.simps vector_add_component one_index)
+
+lemma neg_numeral_index [simp]: "neg_numeral w $ i = neg_numeral w"
+  by (simp only: neg_numeral_def vector_uminus_component numeral_index)
+
 instance vec :: (comm_ring_1, finite) comm_ring_1 ..
 instance vec :: (ring_char_0, finite) ring_char_0 ..
 
@@ -222,7 +231,7 @@
   by (vector field_simps)
 lemma vector_smult_rneg: "(c::'a::ring) *s -x = -(c *s x)" by vector
 lemma vector_smult_lneg: "- (c::'a::ring) *s x = -(c *s x)" by vector
-lemma vector_sneg_minus1: "-x = (- (1::'a::ring_1)) *s x" by vector
+lemma vector_sneg_minus1: "-x = (-1::'a::ring_1) *s x" by vector
 lemma vector_smult_rzero[simp]: "c *s 0 = (0::'a::mult_zero ^ 'n)" by vector
 lemma vector_sub_rdistrib: "((a::'a::ring) - b) *s x = a *s x - b *s x"
   by (vector field_simps)
--- a/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -281,7 +281,7 @@
 lemma scaleR_2:
   fixes x :: "'a::real_vector"
   shows "scaleR 2 x = x + x"
-unfolding one_add_one_is_two [symmetric] scaleR_left_distrib by simp
+unfolding one_add_one [symmetric] scaleR_left_distrib by simp
 
 lemma vector_choose_size: "0 <= c ==> \<exists>(x::'a::euclidean_space). norm x = c"
   apply (rule exI[where x="c *\<^sub>R basis 0 ::'a"]) using DIM_positive[where 'a='a] by auto
--- a/src/HOL/Multivariate_Analysis/Determinants.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Multivariate_Analysis/Determinants.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -286,7 +286,7 @@
 proof-
   have tha: "\<And>(a::'a) b. a = b ==> b = - a ==> a = 0"
     by simp
-  have th1: "of_int (-1) = - 1" by (metis of_int_1 of_int_minus number_of_Min)
+  have th1: "of_int (-1) = - 1" by simp
   let ?p = "Fun.swap i j id"
   let ?A = "\<chi> i. A $ ?p i"
   from r have "A = ?A" by (simp add: vec_eq_iff row_def swap_def)
@@ -1058,8 +1058,7 @@
   unfolding det_def UNIV_2
   unfolding setsum_over_permutations_insert[OF f12]
   unfolding permutes_sing
-  apply (simp add: sign_swap_id sign_id swap_id_eq)
-  by (simp add: arith_simps(31)[symmetric] del: arith_simps(31))
+  by (simp add: sign_swap_id sign_id swap_id_eq)
 qed
 
 lemma det_3: "det (A::'a::comm_ring_1^3^3) =
@@ -1079,9 +1078,7 @@
   unfolding setsum_over_permutations_insert[OF f23]
 
   unfolding permutes_sing
-  apply (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq)
-  apply (simp add: arith_simps(31)[symmetric] del: arith_simps(31))
-  by (simp add: field_simps)
+  by (simp add: sign_swap_id permutation_swap_id sign_compose sign_id swap_id_eq)
 qed
 
 end
--- a/src/HOL/Multivariate_Analysis/Norm_Arith.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Multivariate_Analysis/Norm_Arith.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -104,6 +104,17 @@
   "x \<noteq> y \<longleftrightarrow> \<not> (norm (x - y) \<le> 0)"
   using norm_ge_zero[of "x - y"] by auto
 
+lemmas arithmetic_simps =
+  arith_simps
+  add_numeral_special
+  add_neg_numeral_special
+  add_0_left
+  add_0_right
+  mult_zero_left
+  mult_zero_right
+  mult_1_left
+  mult_1_right
+
 use "normarith.ML"
 
 method_setup norm = {* Scan.succeed (SIMPLE_METHOD' o NormArith.norm_arith_tac)
--- a/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Multivariate_Analysis/Topology_Euclidean_Space.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -5786,7 +5786,7 @@
     { assume as:"dist a b > dist (f n x) (f n y)"
       then obtain Na Nb where "\<forall>m\<ge>Na. dist (f (r m) x) a < (dist a b - dist (f n x) (f n y)) / 2"
         and "\<forall>m\<ge>Nb. dist (f (r m) y) b < (dist a b - dist (f n x) (f n y)) / 2"
-        using lima limb unfolding h_def LIMSEQ_def by (fastforce simp del: less_divide_eq_number_of1)
+        using lima limb unfolding h_def LIMSEQ_def by (fastforce simp del: less_divide_eq_numeral1)
       hence "dist (f (r (Na + Nb + n)) x - f (r (Na + Nb + n)) y) (a - b) < dist a b - dist (f n x) (f n y)"
         apply(erule_tac x="Na+Nb+n" in allE)
         apply(erule_tac x="Na+Nb+n" in allE) apply simp
--- a/src/HOL/Mutabelle/mutabelle_extra.ML	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Mutabelle/mutabelle_extra.ML	Sun Mar 25 20:15:39 2012 +0200
@@ -271,7 +271,7 @@
  @{const_name enum_prod_inst.enum_ex_prod},
  @{const_name Quickcheck.catch_match},
  @{const_name Quickcheck_Exhaustive.unknown},
- @{const_name Int.Bit0}, @{const_name Int.Bit1}
+ @{const_name Num.Bit0}, @{const_name Num.Bit1}
  (*@{const_name "==>"}, @{const_name "=="}*)]
 
 val forbidden_mutant_consts =
--- a/src/HOL/NSA/HyperDef.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/NSA/HyperDef.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -346,8 +346,8 @@
   K (Lin_Arith.add_inj_thms [@{thm star_of_le} RS iffD2,
     @{thm star_of_less} RS iffD2, @{thm star_of_eq} RS iffD2]
   #> Lin_Arith.add_simps [@{thm star_of_zero}, @{thm star_of_one},
-      @{thm star_of_number_of}, @{thm star_of_add}, @{thm star_of_minus},
-      @{thm star_of_diff}, @{thm star_of_mult}]
+      @{thm star_of_numeral}, @{thm star_of_neg_numeral}, @{thm star_of_add},
+      @{thm star_of_minus}, @{thm star_of_diff}, @{thm star_of_mult}]
   #> Lin_Arith.add_inj_const (@{const_name "StarDef.star_of"}, @{typ "real \<Rightarrow> hypreal"}))
 *}
 
@@ -419,10 +419,15 @@
       x ^ Suc (Suc 0) + y ^ Suc (Suc 0) + (hypreal_of_nat (Suc (Suc 0)))*x*y"
 by (simp add: right_distrib left_distrib)
 
-lemma power_hypreal_of_real_number_of:
-     "(number_of v :: hypreal) ^ n = hypreal_of_real ((number_of v) ^ n)"
+lemma power_hypreal_of_real_numeral:
+     "(numeral v :: hypreal) ^ n = hypreal_of_real ((numeral v) ^ n)"
 by simp
-declare power_hypreal_of_real_number_of [of _ "number_of w", simp] for w
+declare power_hypreal_of_real_numeral [of _ "numeral w", simp] for w
+
+lemma power_hypreal_of_real_neg_numeral:
+     "(neg_numeral v :: hypreal) ^ n = hypreal_of_real ((neg_numeral v) ^ n)"
+by simp
+declare power_hypreal_of_real_neg_numeral [of _ "numeral w", simp] for w
 (*
 lemma hrealpow_HFinite:
   fixes x :: "'a::{real_normed_algebra,power} star"
@@ -492,7 +497,7 @@
 by transfer (rule power_one)
 
 lemma hrabs_hyperpow_minus_one [simp]:
-  "\<And>n. abs(-1 pow n) = (1::'a::{number_ring,linordered_idom} star)"
+  "\<And>n. abs(-1 pow n) = (1::'a::{linordered_idom} star)"
 by transfer (rule abs_power_minus_one)
 
 lemma hyperpow_mult:
--- a/src/HOL/NSA/NSA.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/NSA/NSA.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -190,7 +190,7 @@
 lemma SReal_hypreal_of_real [simp]: "hypreal_of_real x \<in> Reals"
 by (simp add: Reals_eq_Standard)
 
-lemma SReal_divide_number_of: "r \<in> Reals ==> r/(number_of w::hypreal) \<in> Reals"
+lemma SReal_divide_numeral: "r \<in> Reals ==> r/(numeral w::hypreal) \<in> Reals"
 by simp
 
 text{*epsilon is not in Reals because it is an infinitesimal*}
@@ -290,8 +290,8 @@
   "(hnorm (x::hypreal) \<in> HFinite) = (x \<in> HFinite)"
 by (simp add: HFinite_def)
 
-lemma HFinite_number_of [simp]: "number_of w \<in> HFinite"
-unfolding star_number_def by (rule HFinite_star_of)
+lemma HFinite_numeral [simp]: "numeral w \<in> HFinite"
+unfolding star_numeral_def by (rule HFinite_star_of)
 
 (** As always with numerals, 0 and 1 are special cases **)
 
@@ -347,7 +347,7 @@
 apply (rule InfinitesimalI)
 apply (rule hypreal_sum_of_halves [THEN subst])
 apply (drule half_gt_zero)
-apply (blast intro: hnorm_add_less SReal_divide_number_of dest: InfinitesimalD)
+apply (blast intro: hnorm_add_less SReal_divide_numeral dest: InfinitesimalD)
 done
 
 lemma Infinitesimal_minus_iff [simp]: "(-x:Infinitesimal) = (x:Infinitesimal)"
@@ -652,7 +652,7 @@
 (*reorientation simplification procedure: reorients (polymorphic)
   0 = x, 1 = x, nnn = x provided x isn't 0, 1 or a numeral.*)
 simproc_setup approx_reorient_simproc
-  ("0 @= x" | "1 @= y" | "number_of w @= z") =
+  ("0 @= x" | "1 @= y" | "numeral w @= z" | "neg_numeral w @= r") =
 {*
   let val rule = @{thm approx_reorient} RS eq_reflection
       fun proc phi ss ct = case term_of ct of
@@ -957,9 +957,9 @@
      "x \<noteq> 0 ==> star_of x \<in> HFinite - Infinitesimal"
 by simp
 
-lemma number_of_not_Infinitesimal [simp]:
-     "number_of w \<noteq> (0::hypreal) ==> (number_of w :: hypreal) \<notin> Infinitesimal"
-by (fast dest: Reals_number_of [THEN SReal_Infinitesimal_zero])
+lemma numeral_not_Infinitesimal [simp]:
+     "numeral w \<noteq> (0::hypreal) ==> (numeral w :: hypreal) \<notin> Infinitesimal"
+by (fast dest: Reals_numeral [THEN SReal_Infinitesimal_zero])
 
 (*again: 1 is a special case, but not 0 this time*)
 lemma one_not_Infinitesimal [simp]:
@@ -1024,31 +1024,31 @@
 apply simp
 done
 
-lemma number_of_approx_iff [simp]:
-     "(number_of v @= (number_of w :: 'a::{number,real_normed_vector} star)) =
-      (number_of v = (number_of w :: 'a))"
-apply (unfold star_number_def)
+lemma numeral_approx_iff [simp]:
+     "(numeral v @= (numeral w :: 'a::{numeral,real_normed_vector} star)) =
+      (numeral v = (numeral w :: 'a))"
+apply (unfold star_numeral_def)
 apply (rule star_of_approx_iff)
 done
 
 (*And also for 0 @= #nn and 1 @= #nn, #nn @= 0 and #nn @= 1.*)
 lemma [simp]:
-  "(number_of w @= (0::'a::{number,real_normed_vector} star)) =
-   (number_of w = (0::'a))"
-  "((0::'a::{number,real_normed_vector} star) @= number_of w) =
-   (number_of w = (0::'a))"
-  "(number_of w @= (1::'b::{number,one,real_normed_vector} star)) =
-   (number_of w = (1::'b))"
-  "((1::'b::{number,one,real_normed_vector} star) @= number_of w) =
-   (number_of w = (1::'b))"
+  "(numeral w @= (0::'a::{numeral,real_normed_vector} star)) =
+   (numeral w = (0::'a))"
+  "((0::'a::{numeral,real_normed_vector} star) @= numeral w) =
+   (numeral w = (0::'a))"
+  "(numeral w @= (1::'b::{numeral,one,real_normed_vector} star)) =
+   (numeral w = (1::'b))"
+  "((1::'b::{numeral,one,real_normed_vector} star) @= numeral w) =
+   (numeral w = (1::'b))"
   "~ (0 @= (1::'c::{zero_neq_one,real_normed_vector} star))"
   "~ (1 @= (0::'c::{zero_neq_one,real_normed_vector} star))"
-apply (unfold star_number_def star_zero_def star_one_def)
+apply (unfold star_numeral_def star_zero_def star_one_def)
 apply (unfold star_of_approx_iff)
 by (auto intro: sym)
 
-lemma star_of_approx_number_of_iff [simp]:
-     "(star_of k @= number_of w) = (k = number_of w)"
+lemma star_of_approx_numeral_iff [simp]:
+     "(star_of k @= numeral w) = (k = numeral w)"
 by (subst star_of_approx_iff [symmetric], auto)
 
 lemma star_of_approx_zero_iff [simp]: "(star_of k @= 0) = (k = 0)"
@@ -1843,8 +1843,11 @@
 lemma st_add: "\<lbrakk>x \<in> HFinite; y \<in> HFinite\<rbrakk> \<Longrightarrow> st (x + y) = st x + st y"
 by (simp add: st_unique st_SReal st_approx_self approx_add)
 
-lemma st_number_of [simp]: "st (number_of w) = number_of w"
-by (rule Reals_number_of [THEN st_SReal_eq])
+lemma st_numeral [simp]: "st (numeral w) = numeral w"
+by (rule Reals_numeral [THEN st_SReal_eq])
+
+lemma st_neg_numeral [simp]: "st (neg_numeral w) = neg_numeral w"
+by (rule Reals_neg_numeral [THEN st_SReal_eq])
 
 lemma st_0 [simp]: "st 0 = 0"
 by (simp add: st_SReal_eq)
--- a/src/HOL/NSA/NSCA.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/NSA/NSCA.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -32,14 +32,14 @@
      "hcmod (hcomplex_of_complex r) \<in> Reals"
 by (simp add: Reals_eq_Standard)
 
-lemma SReal_hcmod_number_of [simp]: "hcmod (number_of w ::hcomplex) \<in> Reals"
+lemma SReal_hcmod_numeral [simp]: "hcmod (numeral w ::hcomplex) \<in> Reals"
 by (simp add: Reals_eq_Standard)
 
 lemma SReal_hcmod_SComplex: "x \<in> SComplex ==> hcmod x \<in> Reals"
 by (simp add: Reals_eq_Standard)
 
-lemma SComplex_divide_number_of:
-     "r \<in> SComplex ==> r/(number_of w::hcomplex) \<in> SComplex"
+lemma SComplex_divide_numeral:
+     "r \<in> SComplex ==> r/(numeral w::hcomplex) \<in> SComplex"
 by simp
 
 lemma SComplex_UNIV_complex:
@@ -211,9 +211,9 @@
       ==> hcomplex_of_complex x \<in> HFinite - Infinitesimal"
 by (rule SComplex_HFinite_diff_Infinitesimal, auto)
 
-lemma number_of_not_Infinitesimal [simp]:
-     "number_of w \<noteq> (0::hcomplex) ==> (number_of w::hcomplex) \<notin> Infinitesimal"
-by (fast dest: Standard_number_of [THEN SComplex_Infinitesimal_zero])
+lemma numeral_not_Infinitesimal [simp]:
+     "numeral w \<noteq> (0::hcomplex) ==> (numeral w::hcomplex) \<notin> Infinitesimal"
+by (fast dest: Standard_numeral [THEN SComplex_Infinitesimal_zero])
 
 lemma approx_SComplex_not_zero:
      "[| y \<in> SComplex; x @= y; y\<noteq> 0 |] ==> x \<noteq> 0"
@@ -223,11 +223,11 @@
      "[|x \<in> SComplex; y \<in> SComplex|] ==> (x @= y) = (x = y)"
 by (auto simp add: Standard_def)
 
-lemma number_of_Infinitesimal_iff [simp]:
-     "((number_of w :: hcomplex) \<in> Infinitesimal) =
-      (number_of w = (0::hcomplex))"
+lemma numeral_Infinitesimal_iff [simp]:
+     "((numeral w :: hcomplex) \<in> Infinitesimal) =
+      (numeral w = (0::hcomplex))"
 apply (rule iffI)
-apply (fast dest: Standard_number_of [THEN SComplex_Infinitesimal_zero])
+apply (fast dest: Standard_numeral [THEN SComplex_Infinitesimal_zero])
 apply (simp (no_asm_simp))
 done
 
@@ -441,8 +441,8 @@
      "[| x \<in> HFinite; y \<in> HFinite |] ==> stc (x + y) = stc(x) + stc(y)"
 by (simp add: stc_unique stc_SComplex stc_approx_self approx_add)
 
-lemma stc_number_of [simp]: "stc (number_of w) = number_of w"
-by (rule Standard_number_of [THEN stc_SComplex_eq])
+lemma stc_numeral [simp]: "stc (numeral w) = numeral w"
+by (rule Standard_numeral [THEN stc_SComplex_eq])
 
 lemma stc_zero [simp]: "stc 0 = 0"
 by simp
--- a/src/HOL/NSA/NSComplex.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/NSA/NSComplex.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -626,32 +626,38 @@
 
 subsection{*Numerals and Arithmetic*}
 
-lemma hcomplex_number_of_def: "(number_of w :: hcomplex) == of_int w"
-by transfer (rule number_of_eq [THEN eq_reflection])
-
 lemma hcomplex_of_hypreal_eq_hcomplex_of_complex: 
      "hcomplex_of_hypreal (hypreal_of_real x) =  
       hcomplex_of_complex (complex_of_real x)"
 by transfer (rule refl)
 
-lemma hcomplex_hypreal_number_of: 
-  "hcomplex_of_complex (number_of w) = hcomplex_of_hypreal(number_of w)"
-by transfer (rule of_real_number_of_eq [symmetric])
+lemma hcomplex_hypreal_numeral:
+  "hcomplex_of_complex (numeral w) = hcomplex_of_hypreal(numeral w)"
+by transfer (rule of_real_numeral [symmetric])
 
-lemma hcomplex_number_of_hcnj [simp]:
-     "hcnj (number_of v :: hcomplex) = number_of v"
-by transfer (rule complex_cnj_number_of)
+lemma hcomplex_hypreal_neg_numeral:
+  "hcomplex_of_complex (neg_numeral w) = hcomplex_of_hypreal(neg_numeral w)"
+by transfer (rule of_real_neg_numeral [symmetric])
+
+lemma hcomplex_numeral_hcnj [simp]:
+     "hcnj (numeral v :: hcomplex) = numeral v"
+by transfer (rule complex_cnj_numeral)
 
-lemma hcomplex_number_of_hcmod [simp]: 
-      "hcmod(number_of v :: hcomplex) = abs (number_of v :: hypreal)"
-by transfer (rule norm_number_of)
+lemma hcomplex_numeral_hcmod [simp]:
+      "hcmod(numeral v :: hcomplex) = (numeral v :: hypreal)"
+by transfer (rule norm_numeral)
+
+lemma hcomplex_neg_numeral_hcmod [simp]: 
+      "hcmod(neg_numeral v :: hcomplex) = (numeral v :: hypreal)"
+by transfer (rule norm_neg_numeral)
 
-lemma hcomplex_number_of_hRe [simp]: 
-      "hRe(number_of v :: hcomplex) = number_of v"
-by transfer (rule complex_Re_number_of)
+lemma hcomplex_numeral_hRe [simp]: 
+      "hRe(numeral v :: hcomplex) = numeral v"
+by transfer (rule complex_Re_numeral)
 
-lemma hcomplex_number_of_hIm [simp]: 
-      "hIm(number_of v :: hcomplex) = 0"
-by transfer (rule complex_Im_number_of)
+lemma hcomplex_numeral_hIm [simp]: 
+      "hIm(numeral v :: hcomplex) = 0"
+by transfer (rule complex_Im_numeral)
 
+(* TODO: add neg_numeral rules above *)
 end
--- a/src/HOL/NSA/StarDef.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/NSA/StarDef.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -522,16 +522,6 @@
 
 end
 
-instantiation star :: (number) number
-begin
-
-definition
-  star_number_def:  "number_of b \<equiv> star_of (number_of b)"
-
-instance ..
-
-end
-
 instance star :: (Rings.dvd) Rings.dvd ..
 
 instantiation star :: (Divides.div) Divides.div
@@ -561,7 +551,7 @@
 end
 
 lemmas star_class_defs [transfer_unfold] =
-  star_zero_def     star_one_def      star_number_def
+  star_zero_def     star_one_def
   star_add_def      star_diff_def     star_minus_def
   star_mult_def     star_divide_def   star_inverse_def
   star_le_def       star_less_def     star_abs_def       star_sgn_def
@@ -575,9 +565,6 @@
 lemma Standard_one: "1 \<in> Standard"
 by (simp add: star_one_def)
 
-lemma Standard_number_of: "number_of b \<in> Standard"
-by (simp add: star_number_def)
-
 lemma Standard_add: "\<lbrakk>x \<in> Standard; y \<in> Standard\<rbrakk> \<Longrightarrow> x + y \<in> Standard"
 by (simp add: star_add_def)
 
@@ -606,7 +593,7 @@
 by (simp add: star_mod_def)
 
 lemmas Standard_simps [simp] =
-  Standard_zero  Standard_one  Standard_number_of
+  Standard_zero  Standard_one
   Standard_add  Standard_diff  Standard_minus
   Standard_mult  Standard_divide  Standard_inverse
   Standard_abs  Standard_div  Standard_mod
@@ -648,9 +635,6 @@
 lemma star_of_one: "star_of 1 = 1"
 by transfer (rule refl)
 
-lemma star_of_number_of: "star_of (number_of x) = number_of x"
-by transfer (rule refl)
-
 text {* @{term star_of} preserves orderings *}
 
 lemma star_of_less: "(star_of x < star_of y) = (x < y)"
@@ -682,34 +666,16 @@
 lemmas star_of_le_1   = star_of_le   [of _ 1, simplified star_of_one]
 lemmas star_of_eq_1   = star_of_eq   [of _ 1, simplified star_of_one]
 
-text{*As above, for numerals*}
-
-lemmas star_of_number_less =
-  star_of_less [of "number_of w", simplified star_of_number_of] for w
-lemmas star_of_number_le   =
-  star_of_le   [of "number_of w", simplified star_of_number_of] for w
-lemmas star_of_number_eq   =
-  star_of_eq   [of "number_of w", simplified star_of_number_of] for w
-
-lemmas star_of_less_number =
-  star_of_less [of _ "number_of w", simplified star_of_number_of] for w
-lemmas star_of_le_number   =
-  star_of_le   [of _ "number_of w", simplified star_of_number_of] for w
-lemmas star_of_eq_number   =
-  star_of_eq   [of _ "number_of w", simplified star_of_number_of] for w
-
 lemmas star_of_simps [simp] =
   star_of_add     star_of_diff    star_of_minus
   star_of_mult    star_of_divide  star_of_inverse
   star_of_div     star_of_mod     star_of_abs
-  star_of_zero    star_of_one     star_of_number_of
+  star_of_zero    star_of_one
   star_of_less    star_of_le      star_of_eq
   star_of_0_less  star_of_0_le    star_of_0_eq
   star_of_less_0  star_of_le_0    star_of_eq_0
   star_of_1_less  star_of_1_le    star_of_1_eq
   star_of_less_1  star_of_le_1    star_of_eq_1
-  star_of_number_less star_of_number_le star_of_number_eq
-  star_of_less_number star_of_le_number star_of_eq_number
 
 subsection {* Ordering and lattice classes *}
 
@@ -984,9 +950,45 @@
 
 subsection {* Number classes *}
 
+instance star :: (numeral) numeral ..
+
+lemma star_numeral_def [transfer_unfold]:
+  "numeral k = star_of (numeral k)"
+by (induct k, simp_all only: numeral.simps star_of_one star_of_add)
+
+lemma Standard_numeral [simp]: "numeral k \<in> Standard"
+by (simp add: star_numeral_def)
+
+lemma star_of_numeral [simp]: "star_of (numeral k) = numeral k"
+by transfer (rule refl)
+
+lemma star_neg_numeral_def [transfer_unfold]:
+  "neg_numeral k = star_of (neg_numeral k)"
+by (simp only: neg_numeral_def star_of_minus star_of_numeral)
+
+lemma Standard_neg_numeral [simp]: "neg_numeral k \<in> Standard"
+by (simp add: star_neg_numeral_def)
+
+lemma star_of_neg_numeral [simp]: "star_of (neg_numeral k) = neg_numeral k"
+by transfer (rule refl)
+
 lemma star_of_nat_def [transfer_unfold]: "of_nat n = star_of (of_nat n)"
 by (induct n, simp_all)
 
+lemmas star_of_compare_numeral [simp] =
+  star_of_less [of "numeral k", simplified star_of_numeral]
+  star_of_le   [of "numeral k", simplified star_of_numeral]
+  star_of_eq   [of "numeral k", simplified star_of_numeral]
+  star_of_less [of _ "numeral k", simplified star_of_numeral]
+  star_of_le   [of _ "numeral k", simplified star_of_numeral]
+  star_of_eq   [of _ "numeral k", simplified star_of_numeral]
+  star_of_less [of "neg_numeral k", simplified star_of_numeral]
+  star_of_le   [of "neg_numeral k", simplified star_of_numeral]
+  star_of_eq   [of "neg_numeral k", simplified star_of_numeral]
+  star_of_less [of _ "neg_numeral k", simplified star_of_numeral]
+  star_of_le   [of _ "neg_numeral k", simplified star_of_numeral]
+  star_of_eq   [of _ "neg_numeral k", simplified star_of_numeral] for k
+
 lemma Standard_of_nat [simp]: "of_nat n \<in> Standard"
 by (simp add: star_of_nat_def)
 
@@ -1010,11 +1012,6 @@
 
 instance star :: (ring_char_0) ring_char_0 ..
 
-instance star :: (number_semiring) number_semiring
-by (intro_classes, simp only: star_number_def star_of_nat_def number_of_int)
-
-instance star :: (number_ring) number_ring
-by (intro_classes, simp only: star_number_def star_of_int_def number_of_eq)
 
 subsection {* Finite class *}
 
--- a/src/HOL/Nat.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Nat.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -181,7 +181,7 @@
 begin
 
 definition
-  One_nat_def [simp, code_post]: "1 = Suc 0"
+  One_nat_def [simp]: "1 = Suc 0"
 
 primrec times_nat where
   mult_0:     "0 * n = (0\<Colon>nat)"
@@ -1782,4 +1782,6 @@
 code_modulename Haskell
   Nat Arith
 
+hide_const (open) of_nat_aux
+
 end
--- a/src/HOL/Nat_Numeral.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Nat_Numeral.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -15,31 +15,13 @@
   Arithmetic for naturals is reduced to that for the non-negative integers.
 *}
 
-instantiation nat :: number_semiring
-begin
-
-definition
-  nat_number_of_def [code_unfold, code del]: "number_of v = nat (number_of v)"
-
-instance proof
-  fix n show "number_of (int n) = (of_nat n :: nat)"
-    unfolding nat_number_of_def number_of_eq by simp
-qed
- 
-end
-
-lemma [code_post]:
-  "nat (number_of v) = number_of v"
-  unfolding nat_number_of_def ..
-
-
 subsection {* Special case: squares and cubes *}
 
 lemma numeral_2_eq_2: "2 = Suc (Suc 0)"
-  by (simp add: nat_number_of_def)
+  by (simp add: nat_number(2-4))
 
 lemma numeral_3_eq_3: "3 = Suc (Suc (Suc 0))"
-  by (simp add: nat_number_of_def)
+  by (simp add: nat_number(2-4))
 
 context power
 begin
@@ -93,26 +75,21 @@
   "(- a)\<twosuperior> = a\<twosuperior>"
   by (simp add: power2_eq_square)
 
-text{*
-  We cannot prove general results about the numeral @{term "-1"},
-  so we have to use @{term "- 1"} instead.
-*}
-
 lemma power_minus1_even [simp]:
-  "(- 1) ^ (2*n) = 1"
+  "-1 ^ (2*n) = 1"
 proof (induct n)
   case 0 show ?case by simp
 next
-  case (Suc n) then show ?case by (simp add: power_add)
+  case (Suc n) then show ?case by (simp add: power_add power2_eq_square)
 qed
 
 lemma power_minus1_odd:
-  "(- 1) ^ Suc (2*n) = - 1"
+  "-1 ^ Suc (2*n) = -1"
   by simp
 
 lemma power_minus_even [simp]:
   "(-a) ^ (2*n) = a ^ (2*n)"
-  by (simp add: power_minus [of a]) 
+  by (simp add: power_minus [of a])
 
 end
 
@@ -261,100 +238,31 @@
 end
 
 lemma power2_sum:
-  fixes x y :: "'a::number_semiring"
+  fixes x y :: "'a::comm_semiring_1"
   shows "(x + y)\<twosuperior> = x\<twosuperior> + y\<twosuperior> + 2 * x * y"
-  by (simp add: algebra_simps power2_eq_square semiring_mult_2_right)
+  by (simp add: algebra_simps power2_eq_square mult_2_right)
 
 lemma power2_diff:
-  fixes x y :: "'a::number_ring"
+  fixes x y :: "'a::comm_ring_1"
   shows "(x - y)\<twosuperior> = x\<twosuperior> + y\<twosuperior> - 2 * x * y"
   by (simp add: ring_distribs power2_eq_square mult_2) (rule mult_commute)
 
 
-subsection {* Predicate for negative binary numbers *}
-
-definition neg  :: "int \<Rightarrow> bool" where
-  "neg Z \<longleftrightarrow> Z < 0"
-
-lemma not_neg_int [simp]: "~ neg (of_nat n)"
-by (simp add: neg_def)
-
-lemma neg_zminus_int [simp]: "neg (- (of_nat (Suc n)))"
-by (simp add: neg_def del: of_nat_Suc)
-
-lemmas neg_eq_less_0 = neg_def
-
-lemma not_neg_eq_ge_0: "(~neg x) = (0 \<le> x)"
-by (simp add: neg_def linorder_not_less)
-
-text{*To simplify inequalities when Numeral1 can get simplified to 1*}
-
-lemma not_neg_0: "~ neg 0"
-by (simp add: One_int_def neg_def)
-
-lemma not_neg_1: "~ neg 1"
-by (simp add: neg_def linorder_not_less)
-
-lemma neg_nat: "neg z ==> nat z = 0"
-by (simp add: neg_def order_less_imp_le) 
-
-lemma not_neg_nat: "~ neg z ==> of_nat (nat z) = z"
-by (simp add: linorder_not_less neg_def)
-
-text {*
-  If @{term Numeral0} is rewritten to 0 then this rule can't be applied:
-  @{term Numeral0} IS @{term "number_of Pls"}
-*}
-
-lemma not_neg_number_of_Pls: "~ neg (number_of Int.Pls)"
-  by (simp add: neg_def)
-
-lemma neg_number_of_Min: "neg (number_of Int.Min)"
-  by (simp add: neg_def)
-
-lemma neg_number_of_Bit0:
-  "neg (number_of (Int.Bit0 w)) = neg (number_of w)"
-  by (simp add: neg_def)
-
-lemma neg_number_of_Bit1:
-  "neg (number_of (Int.Bit1 w)) = neg (number_of w)"
-  by (simp add: neg_def)
-
-lemmas neg_simps [simp] =
-  not_neg_0 not_neg_1
-  not_neg_number_of_Pls neg_number_of_Min
-  neg_number_of_Bit0 neg_number_of_Bit1
-
-
 subsection{*Function @{term nat}: Coercion from Type @{typ int} to @{typ nat}*}
 
 declare nat_1 [simp]
 
-lemma nat_number_of [simp]: "nat (number_of w) = number_of w"
-  by (simp add: nat_number_of_def)
-
-lemma nat_numeral_0_eq_0: "Numeral0 = (0::nat)" (* FIXME delete candidate *)
-  by (fact semiring_numeral_0_eq_0)
-
-lemma nat_numeral_1_eq_1: "Numeral1 = (1::nat)" (* FIXME delete candidate *)
-  by (fact semiring_numeral_1_eq_1)
-
-lemma Numeral1_eq1_nat:
-  "(1::nat) = Numeral1"
+lemma nat_neg_numeral [simp]: "nat (neg_numeral w) = 0"
   by simp
 
 lemma numeral_1_eq_Suc_0: "Numeral1 = Suc 0"
-  by (simp only: nat_numeral_1_eq_1 One_nat_def)
+  by simp
 
 
 subsection{*Function @{term int}: Coercion from Type @{typ nat} to @{typ int}*}
 
-lemma int_nat_number_of [simp]:
-     "int (number_of v) =  
-         (if neg (number_of v :: int) then 0  
-          else (number_of v :: int))"
-  unfolding nat_number_of_def number_of_is_id neg_def
-  by simp (* FIXME: redundant with of_nat_number_of_eq *)
+lemma int_numeral: "int (numeral v) = numeral v"
+  by (rule of_nat_numeral) (* already simp *)
 
 lemma nonneg_int_cases:
   fixes k :: int assumes "0 \<le> k" obtains n where "k = of_nat n"
@@ -368,149 +276,51 @@
 done
 
 lemma Suc_nat_number_of_add:
-     "Suc (number_of v + n) =  
-        (if neg (number_of v :: int) then 1+n else number_of (Int.succ v) + n)"
-  unfolding nat_number_of_def number_of_is_id neg_def numeral_simps
-  by (simp add: Suc_nat_eq_nat_zadd1 add_ac)
-
-lemma Suc_nat_number_of [simp]:
-     "Suc (number_of v) =  
-        (if neg (number_of v :: int) then 1 else number_of (Int.succ v))"
-apply (cut_tac n = 0 in Suc_nat_number_of_add)
-apply (simp cong del: if_weak_cong)
-done
-
-
-subsubsection{*Addition *}
-
-lemma add_nat_number_of [simp]:
-     "(number_of v :: nat) + number_of v' =  
-         (if v < Int.Pls then number_of v'  
-          else if v' < Int.Pls then number_of v  
-          else number_of (v + v'))"
-  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)
+  "Suc (numeral v + n) = numeral (v + Num.One) + n"
+  by simp
 
-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 semiring_one_add_one_is_two)
-
-text {* TODO: replace simp rules above with these generic ones: *}
-
-lemma semiring_add_number_of:
-  "\<lbrakk>Int.Pls \<le> v; Int.Pls \<le> v'\<rbrakk> \<Longrightarrow>
-    (number_of v :: 'a::number_semiring) + number_of v' = number_of (v + v')"
-  unfolding Int.Pls_def
-  by (elim nonneg_int_cases,
-    simp only: number_of_int of_nat_add [symmetric])
-
-lemma semiring_number_of_add_1:
-  "Int.Pls \<le> v \<Longrightarrow>
-    number_of v + (1::'a::number_semiring) = number_of (Int.succ v)"
-  unfolding Int.Pls_def Int.succ_def
-  by (elim nonneg_int_cases,
-    simp only: number_of_int add_commute [where b=1] of_nat_Suc [symmetric])
-
-lemma semiring_1_add_number_of:
-  "Int.Pls \<le> v \<Longrightarrow>
-    (1::'a::number_semiring) + number_of v = number_of (Int.succ v)"
-  unfolding Int.Pls_def Int.succ_def
-  by (elim nonneg_int_cases,
-    simp only: number_of_int add_commute [where b=1] of_nat_Suc [symmetric])
+lemma Suc_numeral [simp]:
+  "Suc (numeral v) = numeral (v + Num.One)"
+  by simp
 
 
 subsubsection{*Subtraction *}
 
 lemma diff_nat_eq_if:
      "nat z - nat z' =  
-        (if neg z' then nat z   
+        (if z' < 0 then nat z   
          else let d = z-z' in     
-              if neg d then 0 else nat d)"
-by (simp add: Let_def nat_diff_distrib [symmetric] neg_eq_less_0 not_neg_eq_ge_0)
-
-
-lemma diff_nat_number_of [simp]: 
-     "(number_of v :: nat) - number_of v' =  
-        (if v' < Int.Pls then number_of v  
-         else let d = number_of (v + uminus v') in     
-              if neg d then 0 else nat d)"
-  unfolding nat_number_of_def number_of_is_id numeral_simps neg_def
-  by auto
+              if d < 0 then 0 else nat d)"
+by (simp add: Let_def nat_diff_distrib [symmetric])
 
-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 *}
+(* Int.nat_diff_distrib has too-strong premises *)
+lemma nat_diff_distrib': "\<lbrakk>0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> nat (x - y) = nat x - nat y"
+apply (rule int_int_eq [THEN iffD1], clarsimp)
+apply (subst zdiff_int [symmetric])
+apply (rule nat_mono, simp_all)
+done
 
-lemma mult_nat_number_of [simp]:
-     "(number_of v :: nat) * number_of v' =  
-       (if v < Int.Pls then 0 else number_of (v * v'))"
-  unfolding nat_number_of_def number_of_is_id numeral_simps
-  by (simp add: nat_mult_distrib)
+lemma diff_nat_numeral [simp]: 
+  "(numeral v :: nat) - numeral v' = nat (numeral v - numeral v')"
+  by (simp only: nat_diff_distrib' zero_le_numeral nat_numeral)
 
-(* TODO: replace mult_nat_number_of with this next rule *)
-lemma semiring_mult_number_of:
-  "\<lbrakk>Int.Pls \<le> v; Int.Pls \<le> v'\<rbrakk> \<Longrightarrow>
-    (number_of v :: 'a::number_semiring) * number_of v' = number_of (v * v')"
-  unfolding Int.Pls_def
-  by (elim nonneg_int_cases,
-    simp only: number_of_int of_nat_mult [symmetric])
+lemma nat_numeral_diff_1 [simp]:
+  "numeral v - (1::nat) = nat (numeral v - 1)"
+  using diff_nat_numeral [of v Num.One] by simp
 
 
 subsection{*Comparisons*}
 
-subsubsection{*Equals (=) *}
-
-lemma eq_nat_number_of [simp]:
-     "((number_of v :: nat) = number_of v') =  
-      (if neg (number_of v :: int) then (number_of v' :: int) \<le> 0
-       else if neg (number_of v' :: int) then (number_of v :: int) = 0
-       else v = v')"
-  unfolding nat_number_of_def number_of_is_id neg_def
-  by auto
-
-
-subsubsection{*Less-than (<) *}
-
-lemma less_nat_number_of [simp]:
-  "(number_of v :: nat) < number_of v' \<longleftrightarrow>
-    (if v < v' then Int.Pls < v' else False)"
-  unfolding nat_number_of_def number_of_is_id numeral_simps
-  by auto
-
-
-subsubsection{*Less-than-or-equal *}
-
-lemma le_nat_number_of [simp]:
-  "(number_of v :: nat) \<le> number_of v' \<longleftrightarrow>
-    (if v \<le> v' then True else v \<le> Int.Pls)"
-  unfolding nat_number_of_def number_of_is_id numeral_simps
-  by auto
-
-(*Maps #n to n for n = 0, 1, 2*)
-lemmas numerals = nat_numeral_0_eq_0 nat_numeral_1_eq_1 numeral_2_eq_2
+(*Maps #n to n for n = 1, 2*)
+lemmas numerals = numeral_1_eq_1 [where 'a=nat] numeral_2_eq_2
 
 
 subsection{*Powers with Numeric Exponents*}
 
 text{*Squares of literal numerals will be evaluated.*}
-lemmas power2_eq_square_number_of [simp] =
-  power2_eq_square [of "number_of w"] for w
+(* FIXME: replace with more general rules for powers of numerals *)
+lemmas power2_eq_square_numeral [simp] =
+    power2_eq_square [of "numeral w"] for w
 
 
 text{*Simprules for comparisons where common factors can be cancelled.*}
@@ -528,8 +338,8 @@
 by simp
 
 (*Expresses a natural number constant as the Suc of another one.
-  NOT suitable for rewriting because n recurs in the condition.*)
-lemmas expand_Suc = Suc_pred' [of "number_of v"] for v
+  NOT suitable for rewriting because n recurs on the right-hand side.*)
+lemmas expand_Suc = Suc_pred' [of "numeral v", OF zero_less_numeral] for v
 
 subsubsection{*Arith *}
 
@@ -539,7 +349,7 @@
 lemma Suc_eq_plus1_left: "Suc n = 1 + n"
   unfolding One_nat_def by simp
 
-(* These two can be useful when m = number_of... *)
+(* These two can be useful when m = numeral... *)
 
 lemma add_eq_if: "(m::nat) + n = (if m=0 then n else Suc ((m - 1) + n))"
   unfolding One_nat_def by (cases m) simp_all
@@ -551,231 +361,108 @@
   unfolding One_nat_def by (cases m) simp_all
 
 
-subsection{*Comparisons involving (0::nat) *}
-
-text{*Simplification already does @{term "n<0"}, @{term "n\<le>0"} and @{term "0\<le>n"}.*}
-
-lemma eq_number_of_0 [simp]:
-  "number_of v = (0::nat) \<longleftrightarrow> v \<le> Int.Pls"
-  unfolding nat_number_of_def number_of_is_id numeral_simps
-  by auto
-
-lemma eq_0_number_of [simp]:
-  "(0::nat) = number_of v \<longleftrightarrow> v \<le> Int.Pls"
-by (rule trans [OF eq_sym_conv eq_number_of_0])
-
-lemma less_0_number_of [simp]:
-   "(0::nat) < number_of v \<longleftrightarrow> Int.Pls < v"
-  unfolding nat_number_of_def number_of_is_id numeral_simps
-  by simp
-
-lemma neg_imp_number_of_eq_0: "neg (number_of v :: int) ==> number_of v = (0::nat)"
-  by (simp del: semiring_numeral_0_eq_0 add: nat_numeral_0_eq_0 [symmetric])
-
-
 subsection{*Comparisons involving  @{term Suc} *}
 
-lemma eq_number_of_Suc [simp]:
-     "(number_of v = Suc n) =  
-        (let pv = number_of (Int.pred v) in  
-         if neg pv then False else nat pv = n)"
-apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less 
-                  number_of_pred nat_number_of_def 
-            split add: split_if)
-apply (rule_tac x = "number_of v" in spec)
-apply (auto simp add: nat_eq_iff)
-done
+lemma eq_numeral_Suc [simp]: "numeral v = Suc n \<longleftrightarrow> nat (numeral v - 1) = n"
+  by (subst expand_Suc, simp only: nat.inject nat_numeral_diff_1)
 
-lemma Suc_eq_number_of [simp]:
-     "(Suc n = number_of v) =  
-        (let pv = number_of (Int.pred v) in  
-         if neg pv then False else nat pv = n)"
-by (rule trans [OF eq_sym_conv eq_number_of_Suc])
+lemma Suc_eq_numeral [simp]: "Suc n = numeral v \<longleftrightarrow> n = nat (numeral v - 1)"
+  by (subst expand_Suc, simp only: nat.inject nat_numeral_diff_1)
 
-lemma less_number_of_Suc [simp]:
-     "(number_of v < Suc n) =  
-        (let pv = number_of (Int.pred v) in  
-         if neg pv then True else nat pv < n)"
-apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less 
-                  number_of_pred nat_number_of_def  
-            split add: split_if)
-apply (rule_tac x = "number_of v" in spec)
-apply (auto simp add: nat_less_iff)
-done
+lemma less_numeral_Suc [simp]: "numeral v < Suc n \<longleftrightarrow> nat (numeral v - 1) < n"
+  by (subst expand_Suc, simp only: Suc_less_eq nat_numeral_diff_1)
 
-lemma less_Suc_number_of [simp]:
-     "(Suc n < number_of v) =  
-        (let pv = number_of (Int.pred v) in  
-         if neg pv then False else n < nat pv)"
-apply (simp only: simp_thms Let_def neg_eq_less_0 linorder_not_less 
-                  number_of_pred nat_number_of_def
-            split add: split_if)
-apply (rule_tac x = "number_of v" in spec)
-apply (auto simp add: zless_nat_eq_int_zless)
-done
+lemma less_Suc_numeral [simp]: "Suc n < numeral v \<longleftrightarrow> n < nat (numeral v - 1)"
+  by (subst expand_Suc, simp only: Suc_less_eq nat_numeral_diff_1)
 
-lemma le_number_of_Suc [simp]:
-     "(number_of v <= Suc n) =  
-        (let pv = number_of (Int.pred v) in  
-         if neg pv then True else nat pv <= n)"
-by (simp add: Let_def linorder_not_less [symmetric])
+lemma le_numeral_Suc [simp]: "numeral v \<le> Suc n \<longleftrightarrow> nat (numeral v - 1) \<le> n"
+  by (subst expand_Suc, simp only: Suc_le_mono nat_numeral_diff_1)
 
-lemma le_Suc_number_of [simp]:
-     "(Suc n <= number_of v) =  
-        (let pv = number_of (Int.pred v) in  
-         if neg pv then False else n <= nat pv)"
-by (simp add: Let_def linorder_not_less [symmetric])
-
-
-lemma eq_number_of_Pls_Min: "(Numeral0 ::int) ~= number_of Int.Min"
-by auto
-
+lemma le_Suc_numeral [simp]: "Suc n \<le> numeral v \<longleftrightarrow> n \<le> nat (numeral v - 1)"
+  by (subst expand_Suc, simp only: Suc_le_mono nat_numeral_diff_1)
 
 
 subsection{*Max and Min Combined with @{term Suc} *}
 
-lemma max_number_of_Suc [simp]:
-     "max (Suc n) (number_of v) =  
-        (let pv = number_of (Int.pred v) in  
-         if neg pv then Suc n else Suc(max n (nat pv)))"
-apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
-            split add: split_if nat.split)
-apply (rule_tac x = "number_of v" in spec) 
-apply auto
-done
- 
-lemma max_Suc_number_of [simp]:
-     "max (number_of v) (Suc n) =  
-        (let pv = number_of (Int.pred v) in  
-         if neg pv then Suc n else Suc(max (nat pv) n))"
-apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
-            split add: split_if nat.split)
-apply (rule_tac x = "number_of v" in spec) 
-apply auto
-done
- 
-lemma min_number_of_Suc [simp]:
-     "min (Suc n) (number_of v) =  
-        (let pv = number_of (Int.pred v) in  
-         if neg pv then 0 else Suc(min n (nat pv)))"
-apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
-            split add: split_if nat.split)
-apply (rule_tac x = "number_of v" in spec) 
-apply auto
-done
- 
-lemma min_Suc_number_of [simp]:
-     "min (number_of v) (Suc n) =  
-        (let pv = number_of (Int.pred v) in  
-         if neg pv then 0 else Suc(min (nat pv) n))"
-apply (simp only: Let_def neg_eq_less_0 number_of_pred nat_number_of_def 
-            split add: split_if nat.split)
-apply (rule_tac x = "number_of v" in spec) 
-apply auto
-done
+lemma max_Suc_numeral [simp]:
+  "max (Suc n) (numeral v) = Suc (max n (nat (numeral v - 1)))"
+  by (subst expand_Suc, simp only: max_Suc_Suc nat_numeral_diff_1)
+
+lemma max_numeral_Suc [simp]:
+  "max (numeral v) (Suc n) = Suc (max (nat (numeral v - 1)) n)"
+  by (subst expand_Suc, simp only: max_Suc_Suc nat_numeral_diff_1)
+
+lemma min_Suc_numeral [simp]:
+  "min (Suc n) (numeral v) = Suc (min n (nat (numeral v - 1)))"
+  by (subst expand_Suc, simp only: min_Suc_Suc nat_numeral_diff_1)
+
+lemma min_numeral_Suc [simp]:
+  "min (numeral v) (Suc n) = Suc (min (nat (numeral v - 1)) n)"
+  by (subst expand_Suc, simp only: min_Suc_Suc nat_numeral_diff_1)
  
 subsection{*Literal arithmetic involving powers*}
 
-lemma power_nat_number_of:
-     "(number_of v :: nat) ^ n =  
-       (if neg (number_of v :: int) then 0^n else nat ((number_of v :: int) ^ n))"
-by (simp only: simp_thms neg_nat not_neg_eq_ge_0 nat_number_of_def nat_power_eq
-         split add: split_if cong: imp_cong)
+(* TODO: replace with more generic rule for powers of numerals *)
+lemma power_nat_numeral:
+  "(numeral v :: nat) ^ n = nat ((numeral v :: int) ^ n)"
+  by (simp only: nat_power_eq zero_le_numeral nat_numeral)
 
-
-lemmas power_nat_number_of_number_of = power_nat_number_of [of _ "number_of w"] for w
-declare power_nat_number_of_number_of [simp]
-
+lemmas power_nat_numeral_numeral = power_nat_numeral [of _ "numeral w"] for w
+declare power_nat_numeral_numeral [simp]
 
 
 text{*For arbitrary rings*}
 
-lemma power_number_of_even:
+lemma power_numeral_even:
   fixes z :: "'a::monoid_mult"
-  shows "z ^ number_of (Int.Bit0 w) = (let w = z ^ (number_of w) in w * w)"
-by (cases "w \<ge> 0") (auto simp add: Let_def Bit0_def nat_number_of_def number_of_is_id
-  nat_add_distrib power_add simp del: nat_number_of)
+  shows "z ^ numeral (Num.Bit0 w) = (let w = z ^ (numeral w) in w * w)"
+  unfolding numeral_Bit0 power_add Let_def ..
 
-lemma power_number_of_odd:
+lemma power_numeral_odd:
   fixes z :: "'a::monoid_mult"
-  shows "z ^ number_of (Int.Bit1 w) = (if (0::int) <= number_of w
-     then (let w = z ^ (number_of w) in z * w * w) else 1)"
-unfolding Let_def Bit1_def nat_number_of_def number_of_is_id
-apply (cases "0 <= w")
-apply (simp only: mult_assoc nat_add_distrib power_add, simp)
-apply (simp add: not_le mult_2 [symmetric] add_assoc)
-done
+  shows "z ^ numeral (Num.Bit1 w) = (let w = z ^ (numeral w) in z * w * w)"
+  unfolding numeral_Bit1 One_nat_def add_Suc_right add_0_right
+  unfolding power_Suc power_add Let_def mult_assoc ..
 
-lemmas zpower_number_of_even = power_number_of_even [where 'a=int]
-lemmas zpower_number_of_odd = power_number_of_odd [where 'a=int]
-
-lemmas power_number_of_even_number_of [simp] =
-    power_number_of_even [of "number_of v"] for v
+lemmas zpower_numeral_even = power_numeral_even [where 'a=int]
+lemmas zpower_numeral_odd = power_numeral_odd [where 'a=int]
 
-lemmas power_number_of_odd_number_of [simp] =
-    power_number_of_odd [of "number_of v"] for v
+lemmas power_numeral_even_numeral [simp] =
+    power_numeral_even [of "numeral v"] for v
 
-lemma nat_number_of_Pls: "Numeral0 = (0::nat)"
-  by (simp add: nat_number_of_def)
-
-lemma nat_number_of_Min [no_atp]: "number_of Int.Min = (0::nat)"
-  apply (simp only: number_of_Min nat_number_of_def nat_zminus_int)
-  done
+lemmas power_numeral_odd_numeral [simp] =
+    power_numeral_odd [of "numeral v"] for v
 
-lemma nat_number_of_Bit0:
-    "number_of (Int.Bit0 w) = (let n::nat = number_of w in n + n)"
-by (cases "w \<ge> 0") (auto simp add: Let_def Bit0_def nat_number_of_def number_of_is_id
-  nat_add_distrib simp del: nat_number_of)
+lemma nat_numeral_Bit0:
+  "numeral (Num.Bit0 w) = (let n::nat = numeral w in n + n)"
+  unfolding numeral_Bit0 Let_def ..
 
-lemma nat_number_of_Bit1:
-  "number_of (Int.Bit1 w) =
-    (if neg (number_of w :: int) then 0
-     else let n = number_of w in Suc (n + n))"
-unfolding Let_def Bit1_def nat_number_of_def number_of_is_id neg_def
-apply (cases "w < 0")
-apply (simp add: mult_2 [symmetric] add_assoc)
-apply (simp only: nat_add_distrib, simp)
-done
+lemma nat_numeral_Bit1:
+  "numeral (Num.Bit1 w) = (let n = numeral w in Suc (n + n))"
+  unfolding numeral_Bit1 Let_def by simp
 
 lemmas eval_nat_numeral =
-  nat_number_of_Bit0 nat_number_of_Bit1
+  nat_numeral_Bit0 nat_numeral_Bit1
 
 lemmas nat_arith =
-  add_nat_number_of
-  diff_nat_number_of
-  mult_nat_number_of
-  eq_nat_number_of
-  less_nat_number_of
+  diff_nat_numeral
 
 lemmas semiring_norm =
-  Let_def arith_simps nat_arith rel_simps neg_simps if_False
-  if_True add_0 add_Suc add_number_of_left mult_number_of_left
+  Let_def arith_simps nat_arith rel_simps
+  if_False if_True
+  add_0 add_Suc add_numeral_left
+  add_neg_numeral_left mult_numeral_left
   numeral_1_eq_1 [symmetric] Suc_eq_plus1
-  numeral_0_eq_0 [symmetric] numerals [symmetric]
-  not_iszero_Numeral1
+  eq_numeral_iff_iszero not_iszero_Numeral1
 
 lemma Let_Suc [simp]: "Let (Suc n) f == f (Suc n)"
   by (fact Let_def)
 
-lemma power_m1_even: "(-1) ^ (2*n) = (1::'a::{number_ring})"
-  by (simp only: number_of_Min power_minus1_even)
-
-lemma power_m1_odd: "(-1) ^ Suc(2*n) = (-1::'a::{number_ring})"
-  by (simp only: number_of_Min power_minus1_odd)
+lemma power_m1_even: "(-1) ^ (2*n) = (1::'a::ring_1)"
+  by (fact power_minus1_even) (* FIXME: duplicate *)
 
-lemma nat_number_of_add_left:
-     "number_of v + (number_of v' + (k::nat)) =  
-         (if neg (number_of v :: int) then number_of v' + k  
-          else if neg (number_of v' :: int) then number_of v + k  
-          else number_of (v + v') + k)"
-by (auto simp add: neg_def)
-
-lemma nat_number_of_mult_left:
-     "number_of v * (number_of v' * (k::nat)) =  
-         (if v < Int.Pls then 0
-          else number_of (v * v') * k)"
-by (auto simp add: not_less Pls_def nat_number_of_def number_of_is_id
-  nat_mult_distrib simp del: nat_number_of)
+lemma power_m1_odd: "(-1) ^ Suc(2*n) = (-1::'a::ring_1)"
+  by (fact power_minus1_odd) (* FIXME: duplicate *)
 
 
 subsection{*Literal arithmetic and @{term of_nat}*}
@@ -784,52 +471,18 @@
      "0 \<le> x ==> of_nat (nat (2 * x)) = of_nat (nat x) + of_nat (nat x)"
 by (simp only: mult_2 nat_add_distrib of_nat_add) 
 
-lemma nat_numeral_m1_eq_0: "-1 = (0::nat)"
-by (simp only: nat_number_of_def)
-
-lemma of_nat_number_of_lemma:
-     "of_nat (number_of v :: nat) =  
-         (if 0 \<le> (number_of v :: int) 
-          then (number_of v :: 'a :: number_semiring)
-          else 0)"
-  by (auto simp add: int_number_of_def nat_number_of_def number_of_int
-    elim!: nonneg_int_cases)
-
-lemma of_nat_number_of_eq [simp]:
-     "of_nat (number_of v :: nat) =  
-         (if neg (number_of v :: int) then 0  
-          else (number_of v :: 'a :: number_semiring))"
-  by (simp only: of_nat_number_of_lemma neg_def, simp)
-
 
 subsubsection{*For simplifying @{term "Suc m - K"} and  @{term "K - Suc m"}*}
 
 text{*Where K above is a literal*}
 
-lemma Suc_diff_eq_diff_pred: "Numeral0 < n ==> Suc m - n = m - (n - Numeral1)"
+lemma Suc_diff_eq_diff_pred: "0 < n ==> Suc m - n = m - (n - Numeral1)"
 by (simp split: nat_diff_split)
 
-text {*Now just instantiating @{text n} to @{text "number_of v"} does
-  the right simplification, but with some redundant inequality
-  tests.*}
-lemma neg_number_of_pred_iff_0:
-  "neg (number_of (Int.pred v)::int) = (number_of v = (0::nat))"
-apply (subgoal_tac "neg (number_of (Int.pred v)) = (number_of v < Suc 0) ")
-apply (simp only: less_Suc_eq_le le_0_eq)
-apply (subst less_number_of_Suc, simp)
-done
-
 text{*No longer required as a simprule because of the @{text inverse_fold}
    simproc*}
-lemma Suc_diff_number_of:
-     "Int.Pls < v ==>
-      Suc m - (number_of v) = m - (number_of (Int.pred v))"
-apply (subst Suc_diff_eq_diff_pred)
-apply simp
-apply (simp del: semiring_numeral_1_eq_1)
-apply (auto simp only: diff_nat_number_of less_0_number_of [symmetric]
-                        neg_number_of_pred_iff_0)
-done
+lemma Suc_diff_numeral: "Suc m - (numeral v) = m - (numeral v - 1)"
+  by (subst expand_Suc, simp only: diff_Suc_Suc)
 
 lemma diff_Suc_eq_diff_pred: "m - Suc n = (m - 1) - n"
 by (simp split: nat_diff_split)
@@ -837,45 +490,22 @@
 
 subsubsection{*For @{term nat_case} and @{term nat_rec}*}
 
-lemma nat_case_number_of [simp]:
-     "nat_case a f (number_of v) =
-        (let pv = number_of (Int.pred v) in
-         if neg pv then a else f (nat pv))"
-by (simp split add: nat.split add: Let_def neg_number_of_pred_iff_0)
+lemma nat_case_numeral [simp]:
+  "nat_case a f (numeral v) = (let pv = nat (numeral v - 1) in f pv)"
+  by (subst expand_Suc, simp only: nat.cases nat_numeral_diff_1 Let_def)
 
 lemma nat_case_add_eq_if [simp]:
-     "nat_case a f ((number_of v) + n) =
-       (let pv = number_of (Int.pred v) in
-         if neg pv then nat_case a f n else f (nat pv + n))"
-apply (subst add_eq_if)
-apply (simp split add: nat.split
-            del: semiring_numeral_1_eq_1
-            add: semiring_numeral_1_eq_1 [symmetric]
-                 numeral_1_eq_Suc_0 [symmetric]
-                 neg_number_of_pred_iff_0)
-done
+  "nat_case a f ((numeral v) + n) = (let pv = nat (numeral v - 1) in f (pv + n))"
+  by (subst expand_Suc, simp only: nat.cases nat_numeral_diff_1 Let_def add_Suc)
 
-lemma nat_rec_number_of [simp]:
-     "nat_rec a f (number_of v) =
-        (let pv = number_of (Int.pred v) in
-         if neg pv then a else f (nat pv) (nat_rec a f (nat pv)))"
-apply (case_tac " (number_of v) ::nat")
-apply (simp_all (no_asm_simp) add: Let_def neg_number_of_pred_iff_0)
-apply (simp split add: split_if_asm)
-done
+lemma nat_rec_numeral [simp]:
+  "nat_rec a f (numeral v) = (let pv = nat (numeral v - 1) in f pv (nat_rec a f pv))"
+  by (subst expand_Suc, simp only: nat_rec_Suc nat_numeral_diff_1 Let_def)
 
 lemma nat_rec_add_eq_if [simp]:
-     "nat_rec a f (number_of v + n) =
-        (let pv = number_of (Int.pred v) in
-         if neg pv then nat_rec a f n
-                   else f (nat pv + n) (nat_rec a f (nat pv + n)))"
-apply (subst add_eq_if)
-apply (simp split add: nat.split
-            del: semiring_numeral_1_eq_1
-            add: semiring_numeral_1_eq_1 [symmetric]
-                 numeral_1_eq_Suc_0 [symmetric]
-                 neg_number_of_pred_iff_0)
-done
+  "nat_rec a f (numeral v + n) =
+    (let pv = nat (numeral v - 1) in f (pv + n) (nat_rec a f (pv + n)))"
+  by (subst expand_Suc, simp only: nat_rec_Suc nat_numeral_diff_1 Let_def add_Suc)
 
 
 subsubsection{*Various Other Lemmas*}
@@ -887,14 +517,14 @@
 
 text{*Lemmas for specialist use, NOT as default simprules*}
 lemma nat_mult_2: "2 * z = (z+z::nat)"
-by (rule semiring_mult_2)
+by (rule mult_2) (* FIXME: duplicate *)
 
 lemma nat_mult_2_right: "z * 2 = (z+z::nat)"
-by (rule semiring_mult_2_right)
+by (rule mult_2_right) (* FIXME: duplicate *)
 
 text{*Case analysis on @{term "n<2"}*}
 lemma less_2_cases: "(n::nat) < 2 ==> n = 0 | n = Suc 0"
-by (auto simp add: nat_1_add_1 [symmetric])
+by (auto simp add: numeral_2_eq_2)
 
 text{*Removal of Small Numerals: 0, 1 and (in additive positions) 2*}
 
@@ -908,4 +538,8 @@
 lemma Suc3_eq_add_3: "Suc (Suc (Suc n)) = 3 + n"
 by simp
 
+text{*Legacy theorems*}
+
+lemmas nat_1_add_1 = one_add_one [where 'a=nat]
+
 end
--- a/src/HOL/Nitpick_Examples/Integer_Nits.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Nitpick_Examples/Integer_Nits.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -198,7 +198,18 @@
 lemma "-5 * 55 > (-260::int)"
 nitpick [unary_ints, expect = none]
 nitpick [binary_ints, expect = none]
+(* BROKEN
+Nitpicking formula...
+Trying 5 scopes:
+  card bin = 1, card int = 1, and bits = 9;
+  card bin = 2, card int = 2, and bits = 9;
+  card bin = 3, card int = 3, and bits = 9;
+  card bin = 4, card int = 4, and bits = 9;
+  card bin = 5, card int = 5, and bits = 9.
+Nitpick found no counterexample.
+*** Unexpected outcome: "none".
 nitpick [binary_ints, bits = 9, expect = genuine]
+*)
 oops
 
 lemma "nat (of_nat n) = n"
--- a/src/HOL/Nominal/Nominal.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Nominal/Nominal.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -3481,7 +3481,7 @@
 by (auto simp add: perm_nat_def)
 
 lemma numeral_nat_eqvt: 
- shows "pi\<bullet>((number_of n)::nat) = number_of n" 
+ shows "pi\<bullet>((numeral n)::nat) = numeral n" 
 by (simp add: perm_nat_def perm_int_def)
 
 lemma max_nat_eqvt:
@@ -3523,7 +3523,11 @@
 by (simp add: perm_int_def)
 
 lemma numeral_int_eqvt: 
- shows "pi\<bullet>((number_of n)::int) = number_of n" 
+ shows "pi\<bullet>((numeral n)::int) = numeral n" 
+by (simp add: perm_int_def perm_int_def)
+
+lemma neg_numeral_int_eqvt:
+ shows "pi\<bullet>((neg_numeral n)::int) = neg_numeral n"
 by (simp add: perm_int_def perm_int_def)
 
 lemma max_int_eqvt:
@@ -3589,7 +3593,7 @@
 (* the lemmas numeral_nat_eqvt numeral_int_eqvt do not conform with the *)
 (* usual form of an eqvt-lemma, but they are needed for analysing       *)
 (* permutations on nats and ints *)
-lemmas [eqvt_force] = numeral_nat_eqvt numeral_int_eqvt
+lemmas [eqvt_force] = numeral_nat_eqvt numeral_int_eqvt neg_numeral_int_eqvt
 
 (***************************************)
 (* setup for the individial atom-kinds *)
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Num.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -0,0 +1,1021 @@
+(*  Title:      HOL/Num.thy
+    Author:     Florian Haftmann
+    Author:     Brian Huffman
+*)
+
+header {* Binary Numerals *}
+
+theory Num
+imports Datatype Power
+begin
+
+subsection {* The @{text num} type *}
+
+datatype num = One | Bit0 num | Bit1 num
+
+text {* Increment function for type @{typ num} *}
+
+primrec inc :: "num \<Rightarrow> num" where
+  "inc One = Bit0 One" |
+  "inc (Bit0 x) = Bit1 x" |
+  "inc (Bit1 x) = Bit0 (inc x)"
+
+text {* Converting between type @{typ num} and type @{typ nat} *}
+
+primrec nat_of_num :: "num \<Rightarrow> nat" where
+  "nat_of_num One = Suc 0" |
+  "nat_of_num (Bit0 x) = nat_of_num x + nat_of_num x" |
+  "nat_of_num (Bit1 x) = Suc (nat_of_num x + nat_of_num x)"
+
+primrec num_of_nat :: "nat \<Rightarrow> num" where
+  "num_of_nat 0 = One" |
+  "num_of_nat (Suc n) = (if 0 < n then inc (num_of_nat n) else One)"
+
+lemma nat_of_num_pos: "0 < nat_of_num x"
+  by (induct x) simp_all
+
+lemma nat_of_num_neq_0: " nat_of_num x \<noteq> 0"
+  by (induct x) simp_all
+
+lemma nat_of_num_inc: "nat_of_num (inc x) = Suc (nat_of_num x)"
+  by (induct x) simp_all
+
+lemma num_of_nat_double:
+  "0 < n \<Longrightarrow> num_of_nat (n + n) = Bit0 (num_of_nat n)"
+  by (induct n) simp_all
+
+text {*
+  Type @{typ num} is isomorphic to the strictly positive
+  natural numbers.
+*}
+
+lemma nat_of_num_inverse: "num_of_nat (nat_of_num x) = x"
+  by (induct x) (simp_all add: num_of_nat_double nat_of_num_pos)
+
+lemma num_of_nat_inverse: "0 < n \<Longrightarrow> nat_of_num (num_of_nat n) = n"
+  by (induct n) (simp_all add: nat_of_num_inc)
+
+lemma num_eq_iff: "x = y \<longleftrightarrow> nat_of_num x = nat_of_num y"
+  apply safe
+  apply (drule arg_cong [where f=num_of_nat])
+  apply (simp add: nat_of_num_inverse)
+  done
+
+lemma num_induct [case_names One inc]:
+  fixes P :: "num \<Rightarrow> bool"
+  assumes One: "P One"
+    and inc: "\<And>x. P x \<Longrightarrow> P (inc x)"
+  shows "P x"
+proof -
+  obtain n where n: "Suc n = nat_of_num x"
+    by (cases "nat_of_num x", simp_all add: nat_of_num_neq_0)
+  have "P (num_of_nat (Suc n))"
+  proof (induct n)
+    case 0 show ?case using One by simp
+  next
+    case (Suc n)
+    then have "P (inc (num_of_nat (Suc n)))" by (rule inc)
+    then show "P (num_of_nat (Suc (Suc n)))" by simp
+  qed
+  with n show "P x"
+    by (simp add: nat_of_num_inverse)
+qed
+
+text {*
+  From now on, there are two possible models for @{typ num}:
+  as positive naturals (rule @{text "num_induct"})
+  and as digit representation (rules @{text "num.induct"}, @{text "num.cases"}).
+*}
+
+
+subsection {* Numeral operations *}
+
+instantiation num :: "{plus,times,linorder}"
+begin
+
+definition [code del]:
+  "m + n = num_of_nat (nat_of_num m + nat_of_num n)"
+
+definition [code del]:
+  "m * n = num_of_nat (nat_of_num m * nat_of_num n)"
+
+definition [code del]:
+  "m \<le> n \<longleftrightarrow> nat_of_num m \<le> nat_of_num n"
+
+definition [code del]:
+  "m < n \<longleftrightarrow> nat_of_num m < nat_of_num n"
+
+instance
+  by (default, auto simp add: less_num_def less_eq_num_def num_eq_iff)
+
+end
+
+lemma nat_of_num_add: "nat_of_num (x + y) = nat_of_num x + nat_of_num y"
+  unfolding plus_num_def
+  by (intro num_of_nat_inverse add_pos_pos nat_of_num_pos)
+
+lemma nat_of_num_mult: "nat_of_num (x * y) = nat_of_num x * nat_of_num y"
+  unfolding times_num_def
+  by (intro num_of_nat_inverse mult_pos_pos nat_of_num_pos)
+
+lemma add_num_simps [simp, code]:
+  "One + One = Bit0 One"
+  "One + Bit0 n = Bit1 n"
+  "One + Bit1 n = Bit0 (n + One)"
+  "Bit0 m + One = Bit1 m"
+  "Bit0 m + Bit0 n = Bit0 (m + n)"
+  "Bit0 m + Bit1 n = Bit1 (m + n)"
+  "Bit1 m + One = Bit0 (m + One)"
+  "Bit1 m + Bit0 n = Bit1 (m + n)"
+  "Bit1 m + Bit1 n = Bit0 (m + n + One)"
+  by (simp_all add: num_eq_iff nat_of_num_add)
+
+lemma mult_num_simps [simp, code]:
+  "m * One = m"
+  "One * n = n"
+  "Bit0 m * Bit0 n = Bit0 (Bit0 (m * n))"
+  "Bit0 m * Bit1 n = Bit0 (m * Bit1 n)"
+  "Bit1 m * Bit0 n = Bit0 (Bit1 m * n)"
+  "Bit1 m * Bit1 n = Bit1 (m + n + Bit0 (m * n))"
+  by (simp_all add: num_eq_iff nat_of_num_add
+    nat_of_num_mult left_distrib right_distrib)
+
+lemma eq_num_simps:
+  "One = One \<longleftrightarrow> True"
+  "One = Bit0 n \<longleftrightarrow> False"
+  "One = Bit1 n \<longleftrightarrow> False"
+  "Bit0 m = One \<longleftrightarrow> False"
+  "Bit1 m = One \<longleftrightarrow> False"
+  "Bit0 m = Bit0 n \<longleftrightarrow> m = n"
+  "Bit0 m = Bit1 n \<longleftrightarrow> False"
+  "Bit1 m = Bit0 n \<longleftrightarrow> False"
+  "Bit1 m = Bit1 n \<longleftrightarrow> m = n"
+  by simp_all
+
+lemma le_num_simps [simp, code]:
+  "One \<le> n \<longleftrightarrow> True"
+  "Bit0 m \<le> One \<longleftrightarrow> False"
+  "Bit1 m \<le> One \<longleftrightarrow> False"
+  "Bit0 m \<le> Bit0 n \<longleftrightarrow> m \<le> n"
+  "Bit0 m \<le> Bit1 n \<longleftrightarrow> m \<le> n"
+  "Bit1 m \<le> Bit1 n \<longleftrightarrow> m \<le> n"
+  "Bit1 m \<le> Bit0 n \<longleftrightarrow> m < n"
+  using nat_of_num_pos [of n] nat_of_num_pos [of m]
+  by (auto simp add: less_eq_num_def less_num_def)
+
+lemma less_num_simps [simp, code]:
+  "m < One \<longleftrightarrow> False"
+  "One < Bit0 n \<longleftrightarrow> True"
+  "One < Bit1 n \<longleftrightarrow> True"
+  "Bit0 m < Bit0 n \<longleftrightarrow> m < n"
+  "Bit0 m < Bit1 n \<longleftrightarrow> m \<le> n"
+  "Bit1 m < Bit1 n \<longleftrightarrow> m < n"
+  "Bit1 m < Bit0 n \<longleftrightarrow> m < n"
+  using nat_of_num_pos [of n] nat_of_num_pos [of m]
+  by (auto simp add: less_eq_num_def less_num_def)
+
+text {* Rules using @{text One} and @{text inc} as constructors *}
+
+lemma add_One: "x + One = inc x"
+  by (simp add: num_eq_iff nat_of_num_add nat_of_num_inc)
+
+lemma add_One_commute: "One + n = n + One"
+  by (induct n) simp_all
+
+lemma add_inc: "x + inc y = inc (x + y)"
+  by (simp add: num_eq_iff nat_of_num_add nat_of_num_inc)
+
+lemma mult_inc: "x * inc y = x * y + x"
+  by (simp add: num_eq_iff nat_of_num_mult nat_of_num_add nat_of_num_inc)
+
+text {* The @{const num_of_nat} conversion *}
+
+lemma num_of_nat_One:
+  "n \<le> 1 \<Longrightarrow> num_of_nat n = Num.One"
+  by (cases n) simp_all
+
+lemma num_of_nat_plus_distrib:
+  "0 < m \<Longrightarrow> 0 < n \<Longrightarrow> num_of_nat (m + n) = num_of_nat m + num_of_nat n"
+  by (induct n) (auto simp add: add_One add_One_commute add_inc)
+
+text {* A double-and-decrement function *}
+
+primrec BitM :: "num \<Rightarrow> num" where
+  "BitM One = One" |
+  "BitM (Bit0 n) = Bit1 (BitM n)" |
+  "BitM (Bit1 n) = Bit1 (Bit0 n)"
+
+lemma BitM_plus_one: "BitM n + One = Bit0 n"
+  by (induct n) simp_all
+
+lemma one_plus_BitM: "One + BitM n = Bit0 n"
+  unfolding add_One_commute BitM_plus_one ..
+
+text {* Squaring and exponentiation *}
+
+primrec sqr :: "num \<Rightarrow> num" where
+  "sqr One = One" |
+  "sqr (Bit0 n) = Bit0 (Bit0 (sqr n))" |
+  "sqr (Bit1 n) = Bit1 (Bit0 (sqr n + n))"
+
+primrec pow :: "num \<Rightarrow> num \<Rightarrow> num" where
+  "pow x One = x" |
+  "pow x (Bit0 y) = sqr (pow x y)" |
+  "pow x (Bit1 y) = x * sqr (pow x y)"
+
+lemma nat_of_num_sqr: "nat_of_num (sqr x) = nat_of_num x * nat_of_num x"
+  by (induct x, simp_all add: algebra_simps nat_of_num_add)
+
+lemma sqr_conv_mult: "sqr x = x * x"
+  by (simp add: num_eq_iff nat_of_num_sqr nat_of_num_mult)
+
+
+subsection {* Numary numerals *}
+
+text {*
+  We embed numary representations into a generic algebraic
+  structure using @{text numeral}.
+*}
+
+class numeral = one + semigroup_add
+begin
+
+primrec numeral :: "num \<Rightarrow> 'a" where
+  numeral_One: "numeral One = 1" |
+  numeral_Bit0: "numeral (Bit0 n) = numeral n + numeral n" |
+  numeral_Bit1: "numeral (Bit1 n) = numeral n + numeral n + 1"
+
+lemma one_plus_numeral_commute: "1 + numeral x = numeral x + 1"
+  apply (induct x)
+  apply simp
+  apply (simp add: add_assoc [symmetric], simp add: add_assoc)
+  apply (simp add: add_assoc [symmetric], simp add: add_assoc)
+  done
+
+lemma numeral_inc: "numeral (inc x) = numeral x + 1"
+proof (induct x)
+  case (Bit1 x)
+  have "numeral x + (1 + numeral x) + 1 = numeral x + (numeral x + 1) + 1"
+    by (simp only: one_plus_numeral_commute)
+  with Bit1 show ?case
+    by (simp add: add_assoc)
+qed simp_all
+
+declare numeral.simps [simp del]
+
+abbreviation "Numeral1 \<equiv> numeral One"
+
+declare numeral_One [code_post]
+
+end
+
+text {* Negative numerals. *}
+
+class neg_numeral = numeral + group_add
+begin
+
+definition neg_numeral :: "num \<Rightarrow> 'a" where
+  "neg_numeral k = - numeral k"
+
+end
+
+text {* Numeral syntax. *}
+
+syntax
+  "_Numeral" :: "num_const \<Rightarrow> 'a"    ("_")
+
+parse_translation {*
+let
+  fun num_of_int n = if n > 0 then case IntInf.quotRem (n, 2)
+     of (0, 1) => Syntax.const @{const_name One}
+      | (n, 0) => Syntax.const @{const_name Bit0} $ num_of_int n
+      | (n, 1) => Syntax.const @{const_name Bit1} $ num_of_int n
+    else raise Match;
+  val pos = Syntax.const @{const_name numeral}
+  val neg = Syntax.const @{const_name neg_numeral}
+  val one = Syntax.const @{const_name Groups.one}
+  val zero = Syntax.const @{const_name Groups.zero}
+  fun numeral_tr [(c as Const (@{syntax_const "_constrain"}, _)) $ t $ u] =
+        c $ numeral_tr [t] $ u
+    | numeral_tr [Const (num, _)] =
+        let
+          val {value, ...} = Lexicon.read_xnum num;
+        in
+          if value = 0 then zero else
+          if value > 0
+          then pos $ num_of_int value
+          else neg $ num_of_int (~value)
+        end
+    | numeral_tr ts = raise TERM ("numeral_tr", ts);
+in [("_Numeral", numeral_tr)] end
+*}
+
+typed_print_translation (advanced) {*
+let
+  fun dest_num (Const (@{const_syntax Bit0}, _) $ n) = 2 * dest_num n
+    | dest_num (Const (@{const_syntax Bit1}, _) $ n) = 2 * dest_num n + 1
+    | dest_num (Const (@{const_syntax One}, _)) = 1;
+  fun num_tr' sign ctxt T [n] =
+    let
+      val k = dest_num n;
+      val t' = Syntax.const @{syntax_const "_Numeral"} $
+        Syntax.free (sign ^ string_of_int k);
+    in
+      case T of
+        Type (@{type_name fun}, [_, T']) =>
+          if not (Config.get ctxt show_types) andalso can Term.dest_Type T' then t'
+          else Syntax.const @{syntax_const "_constrain"} $ t' $ Syntax_Phases.term_of_typ ctxt T'
+      | T' => if T' = dummyT then t' else raise Match
+    end;
+in [(@{const_syntax numeral}, num_tr' ""),
+    (@{const_syntax neg_numeral}, num_tr' "-")] end
+*}
+
+subsection {* Class-specific numeral rules *}
+
+text {*
+  @{const numeral} is a morphism.
+*}
+
+subsubsection {* Structures with addition: class @{text numeral} *}
+
+context numeral
+begin
+
+lemma numeral_add: "numeral (m + n) = numeral m + numeral n"
+  by (induct n rule: num_induct)
+     (simp_all only: numeral_One add_One add_inc numeral_inc add_assoc)
+
+lemma numeral_plus_numeral: "numeral m + numeral n = numeral (m + n)"
+  by (rule numeral_add [symmetric])
+
+lemma numeral_plus_one: "numeral n + 1 = numeral (n + One)"
+  using numeral_add [of n One] by (simp add: numeral_One)
+
+lemma one_plus_numeral: "1 + numeral n = numeral (One + n)"
+  using numeral_add [of One n] by (simp add: numeral_One)
+
+lemma one_add_one: "1 + 1 = 2"
+  using numeral_add [of One One] by (simp add: numeral_One)
+
+lemmas add_numeral_special =
+  numeral_plus_one one_plus_numeral one_add_one
+
+end
+
+subsubsection {*
+  Structures with negation: class @{text neg_numeral}
+*}
+
+context neg_numeral
+begin
+
+text {* Numerals form an abelian subgroup. *}
+
+inductive is_num :: "'a \<Rightarrow> bool" where
+  "is_num 1" |
+  "is_num x \<Longrightarrow> is_num (- x)" |
+  "\<lbrakk>is_num x; is_num y\<rbrakk> \<Longrightarrow> is_num (x + y)"
+
+lemma is_num_numeral: "is_num (numeral k)"
+  by (induct k, simp_all add: numeral.simps is_num.intros)
+
+lemma is_num_add_commute:
+  "\<lbrakk>is_num x; is_num y\<rbrakk> \<Longrightarrow> x + y = y + x"
+  apply (induct x rule: is_num.induct)
+  apply (induct y rule: is_num.induct)
+  apply simp
+  apply (rule_tac a=x in add_left_imp_eq)
+  apply (rule_tac a=x in add_right_imp_eq)
+  apply (simp add: add_assoc minus_add_cancel)
+  apply (simp add: add_assoc [symmetric], simp add: add_assoc)
+  apply (rule_tac a=x in add_left_imp_eq)
+  apply (rule_tac a=x in add_right_imp_eq)
+  apply (simp add: add_assoc minus_add_cancel add_minus_cancel)
+  apply (simp add: add_assoc, simp add: add_assoc [symmetric])
+  done
+
+lemma is_num_add_left_commute:
+  "\<lbrakk>is_num x; is_num y\<rbrakk> \<Longrightarrow> x + (y + z) = y + (x + z)"
+  by (simp only: add_assoc [symmetric] is_num_add_commute)
+
+lemmas is_num_normalize =
+  add_assoc is_num_add_commute is_num_add_left_commute
+  is_num.intros is_num_numeral
+  diff_minus minus_add add_minus_cancel minus_add_cancel
+
+definition dbl :: "'a \<Rightarrow> 'a" where "dbl x = x + x"
+definition dbl_inc :: "'a \<Rightarrow> 'a" where "dbl_inc x = x + x + 1"
+definition dbl_dec :: "'a \<Rightarrow> 'a" where "dbl_dec x = x + x - 1"
+
+definition sub :: "num \<Rightarrow> num \<Rightarrow> 'a" where
+  "sub k l = numeral k - numeral l"
+
+lemma numeral_BitM: "numeral (BitM n) = numeral (Bit0 n) - 1"
+  by (simp only: BitM_plus_one [symmetric] numeral_add numeral_One eq_diff_eq)
+
+lemma dbl_simps [simp]:
+  "dbl (neg_numeral k) = neg_numeral (Bit0 k)"
+  "dbl 0 = 0"
+  "dbl 1 = 2"
+  "dbl (numeral k) = numeral (Bit0 k)"
+  unfolding dbl_def neg_numeral_def numeral.simps
+  by (simp_all add: minus_add)
+
+lemma dbl_inc_simps [simp]:
+  "dbl_inc (neg_numeral k) = neg_numeral (BitM k)"
+  "dbl_inc 0 = 1"
+  "dbl_inc 1 = 3"
+  "dbl_inc (numeral k) = numeral (Bit1 k)"
+  unfolding dbl_inc_def neg_numeral_def numeral.simps numeral_BitM
+  by (simp_all add: is_num_normalize)
+
+lemma dbl_dec_simps [simp]:
+  "dbl_dec (neg_numeral k) = neg_numeral (Bit1 k)"
+  "dbl_dec 0 = -1"
+  "dbl_dec 1 = 1"
+  "dbl_dec (numeral k) = numeral (BitM k)"
+  unfolding dbl_dec_def neg_numeral_def numeral.simps numeral_BitM
+  by (simp_all add: is_num_normalize)
+
+lemma sub_num_simps [simp]:
+  "sub One One = 0"
+  "sub One (Bit0 l) = neg_numeral (BitM l)"
+  "sub One (Bit1 l) = neg_numeral (Bit0 l)"
+  "sub (Bit0 k) One = numeral (BitM k)"
+  "sub (Bit1 k) One = numeral (Bit0 k)"
+  "sub (Bit0 k) (Bit0 l) = dbl (sub k l)"
+  "sub (Bit0 k) (Bit1 l) = dbl_dec (sub k l)"
+  "sub (Bit1 k) (Bit0 l) = dbl_inc (sub k l)"
+  "sub (Bit1 k) (Bit1 l) = dbl (sub k l)"
+  unfolding dbl_def dbl_dec_def dbl_inc_def sub_def
+  unfolding neg_numeral_def numeral.simps numeral_BitM
+  by (simp_all add: is_num_normalize)
+
+lemma add_neg_numeral_simps:
+  "numeral m + neg_numeral n = sub m n"
+  "neg_numeral m + numeral n = sub n m"
+  "neg_numeral m + neg_numeral n = neg_numeral (m + n)"
+  unfolding sub_def diff_minus neg_numeral_def numeral_add numeral.simps
+  by (simp_all add: is_num_normalize)
+
+lemma add_neg_numeral_special:
+  "1 + neg_numeral m = sub One m"
+  "neg_numeral m + 1 = sub One m"
+  unfolding sub_def diff_minus neg_numeral_def numeral_add numeral.simps
+  by (simp_all add: is_num_normalize)
+
+lemma diff_numeral_simps:
+  "numeral m - numeral n = sub m n"
+  "numeral m - neg_numeral n = numeral (m + n)"
+  "neg_numeral m - numeral n = neg_numeral (m + n)"
+  "neg_numeral m - neg_numeral n = sub n m"
+  unfolding neg_numeral_def sub_def diff_minus numeral_add numeral.simps
+  by (simp_all add: is_num_normalize)
+
+lemma diff_numeral_special:
+  "1 - numeral n = sub One n"
+  "1 - neg_numeral n = numeral (One + n)"
+  "numeral m - 1 = sub m One"
+  "neg_numeral m - 1 = neg_numeral (m + One)"
+  unfolding neg_numeral_def sub_def diff_minus numeral_add numeral.simps
+  by (simp_all add: is_num_normalize)
+
+lemma minus_one: "- 1 = -1"
+  unfolding neg_numeral_def numeral.simps ..
+
+lemma minus_numeral: "- numeral n = neg_numeral n"
+  unfolding neg_numeral_def ..
+
+lemma minus_neg_numeral: "- neg_numeral n = numeral n"
+  unfolding neg_numeral_def by simp
+
+lemmas minus_numeral_simps [simp] =
+  minus_one minus_numeral minus_neg_numeral
+
+end
+
+subsubsection {*
+  Structures with multiplication: class @{text semiring_numeral}
+*}
+
+class semiring_numeral = semiring + monoid_mult
+begin
+
+subclass numeral ..
+
+lemma numeral_mult: "numeral (m * n) = numeral m * numeral n"
+  apply (induct n rule: num_induct)
+  apply (simp add: numeral_One)
+  apply (simp add: mult_inc numeral_inc numeral_add numeral_inc right_distrib)
+  done
+
+lemma numeral_times_numeral: "numeral m * numeral n = numeral (m * n)"
+  by (rule numeral_mult [symmetric])
+
+end
+
+subsubsection {*
+  Structures with a zero: class @{text semiring_1}
+*}
+
+context semiring_1
+begin
+
+subclass semiring_numeral ..
+
+lemma of_nat_numeral [simp]: "of_nat (numeral n) = numeral n"
+  by (induct n,
+    simp_all only: numeral.simps numeral_class.numeral.simps of_nat_add of_nat_1)
+
+end
+
+lemma nat_of_num_numeral: "nat_of_num = numeral"
+proof
+  fix n
+  have "numeral n = nat_of_num n"
+    by (induct n) (simp_all add: numeral.simps)
+  then show "nat_of_num n = numeral n" by simp
+qed
+
+subsubsection {*
+  Equality: class @{text semiring_char_0}
+*}
+
+context semiring_char_0
+begin
+
+lemma numeral_eq_iff: "numeral m = numeral n \<longleftrightarrow> m = n"
+  unfolding of_nat_numeral [symmetric] nat_of_num_numeral [symmetric]
+    of_nat_eq_iff num_eq_iff ..
+
+lemma numeral_eq_one_iff: "numeral n = 1 \<longleftrightarrow> n = One"
+  by (rule numeral_eq_iff [of n One, unfolded numeral_One])
+
+lemma one_eq_numeral_iff: "1 = numeral n \<longleftrightarrow> One = n"
+  by (rule numeral_eq_iff [of One n, unfolded numeral_One])
+
+lemma numeral_neq_zero: "numeral n \<noteq> 0"
+  unfolding of_nat_numeral [symmetric] nat_of_num_numeral [symmetric]
+  by (simp add: nat_of_num_pos)
+
+lemma zero_neq_numeral: "0 \<noteq> numeral n"
+  unfolding eq_commute [of 0] by (rule numeral_neq_zero)
+
+lemmas eq_numeral_simps [simp] =
+  numeral_eq_iff
+  numeral_eq_one_iff
+  one_eq_numeral_iff
+  numeral_neq_zero
+  zero_neq_numeral
+
+end
+
+subsubsection {*
+  Comparisons: class @{text linordered_semidom}
+*}
+
+text {*  Could be perhaps more general than here. *}
+
+context linordered_semidom
+begin
+
+lemma numeral_le_iff: "numeral m \<le> numeral n \<longleftrightarrow> m \<le> n"
+proof -
+  have "of_nat (numeral m) \<le> of_nat (numeral n) \<longleftrightarrow> m \<le> n"
+    unfolding less_eq_num_def nat_of_num_numeral of_nat_le_iff ..
+  then show ?thesis by simp
+qed
+
+lemma one_le_numeral: "1 \<le> numeral n"
+using numeral_le_iff [of One n] by (simp add: numeral_One)
+
+lemma numeral_le_one_iff: "numeral n \<le> 1 \<longleftrightarrow> n \<le> One"
+using numeral_le_iff [of n One] by (simp add: numeral_One)
+
+lemma numeral_less_iff: "numeral m < numeral n \<longleftrightarrow> m < n"
+proof -
+  have "of_nat (numeral m) < of_nat (numeral n) \<longleftrightarrow> m < n"
+    unfolding less_num_def nat_of_num_numeral of_nat_less_iff ..
+  then show ?thesis by simp
+qed
+
+lemma not_numeral_less_one: "\<not> numeral n < 1"
+  using numeral_less_iff [of n One] by (simp add: numeral_One)
+
+lemma one_less_numeral_iff: "1 < numeral n \<longleftrightarrow> One < n"
+  using numeral_less_iff [of One n] by (simp add: numeral_One)
+
+lemma zero_le_numeral: "0 \<le> numeral n"
+  by (induct n) (simp_all add: numeral.simps)
+
+lemma zero_less_numeral: "0 < numeral n"
+  by (induct n) (simp_all add: numeral.simps add_pos_pos)
+
+lemma not_numeral_le_zero: "\<not> numeral n \<le> 0"
+  by (simp add: not_le zero_less_numeral)
+
+lemma not_numeral_less_zero: "\<not> numeral n < 0"
+  by (simp add: not_less zero_le_numeral)
+
+lemmas le_numeral_extra =
+  zero_le_one not_one_le_zero
+  order_refl [of 0] order_refl [of 1]
+
+lemmas less_numeral_extra =
+  zero_less_one not_one_less_zero
+  less_irrefl [of 0] less_irrefl [of 1]
+
+lemmas le_numeral_simps [simp] =
+  numeral_le_iff
+  one_le_numeral
+  numeral_le_one_iff
+  zero_le_numeral
+  not_numeral_le_zero
+
+lemmas less_numeral_simps [simp] =
+  numeral_less_iff
+  one_less_numeral_iff
+  not_numeral_less_one
+  zero_less_numeral
+  not_numeral_less_zero
+
+end
+
+subsubsection {*
+  Multiplication and negation: class @{text ring_1}
+*}
+
+context ring_1
+begin
+
+subclass neg_numeral ..
+
+lemma mult_neg_numeral_simps:
+  "neg_numeral m * neg_numeral n = numeral (m * n)"
+  "neg_numeral m * numeral n = neg_numeral (m * n)"
+  "numeral m * neg_numeral n = neg_numeral (m * n)"
+  unfolding neg_numeral_def mult_minus_left mult_minus_right
+  by (simp_all only: minus_minus numeral_mult)
+
+lemma mult_minus1 [simp]: "-1 * z = - z"
+  unfolding neg_numeral_def numeral.simps mult_minus_left by simp
+
+lemma mult_minus1_right [simp]: "z * -1 = - z"
+  unfolding neg_numeral_def numeral.simps mult_minus_right by simp
+
+end
+
+subsubsection {*
+  Equality using @{text iszero} for rings with non-zero characteristic
+*}
+
+context ring_1
+begin
+
+definition iszero :: "'a \<Rightarrow> bool"
+  where "iszero z \<longleftrightarrow> z = 0"
+
+lemma iszero_0 [simp]: "iszero 0"
+  by (simp add: iszero_def)
+
+lemma not_iszero_1 [simp]: "\<not> iszero 1"
+  by (simp add: iszero_def)
+
+lemma not_iszero_Numeral1: "\<not> iszero Numeral1"
+  by (simp add: numeral_One)
+
+lemma iszero_neg_numeral [simp]:
+  "iszero (neg_numeral w) \<longleftrightarrow> iszero (numeral w)"
+  unfolding iszero_def neg_numeral_def
+  by (rule neg_equal_0_iff_equal)
+
+lemma eq_iff_iszero_diff: "x = y \<longleftrightarrow> iszero (x - y)"
+  unfolding iszero_def by (rule eq_iff_diff_eq_0)
+
+text {* The @{text "eq_numeral_iff_iszero"} lemmas are not declared
+@{text "[simp]"} by default, because for rings of characteristic zero,
+better simp rules are possible. For a type like integers mod @{text
+"n"}, type-instantiated versions of these rules should be added to the
+simplifier, along with a type-specific rule for deciding propositions
+of the form @{text "iszero (numeral w)"}.
+
+bh: Maybe it would not be so bad to just declare these as simp
+rules anyway? I should test whether these rules take precedence over
+the @{text "ring_char_0"} rules in the simplifier.
+*}
+
+lemma eq_numeral_iff_iszero:
+  "numeral x = numeral y \<longleftrightarrow> iszero (sub x y)"
+  "numeral x = neg_numeral y \<longleftrightarrow> iszero (numeral (x + y))"
+  "neg_numeral x = numeral y \<longleftrightarrow> iszero (numeral (x + y))"
+  "neg_numeral x = neg_numeral y \<longleftrightarrow> iszero (sub y x)"
+  "numeral x = 1 \<longleftrightarrow> iszero (sub x One)"
+  "1 = numeral y \<longleftrightarrow> iszero (sub One y)"
+  "neg_numeral x = 1 \<longleftrightarrow> iszero (numeral (x + One))"
+  "1 = neg_numeral y \<longleftrightarrow> iszero (numeral (One + y))"
+  "numeral x = 0 \<longleftrightarrow> iszero (numeral x)"
+  "0 = numeral y \<longleftrightarrow> iszero (numeral y)"
+  "neg_numeral x = 0 \<longleftrightarrow> iszero (numeral x)"
+  "0 = neg_numeral y \<longleftrightarrow> iszero (numeral y)"
+  unfolding eq_iff_iszero_diff diff_numeral_simps diff_numeral_special
+  by simp_all
+
+end
+
+subsubsection {*
+  Equality and negation: class @{text ring_char_0}
+*}
+
+class ring_char_0 = ring_1 + semiring_char_0
+begin
+
+lemma not_iszero_numeral [simp]: "\<not> iszero (numeral w)"
+  by (simp add: iszero_def)
+
+lemma neg_numeral_eq_iff: "neg_numeral m = neg_numeral n \<longleftrightarrow> m = n"
+  by (simp only: neg_numeral_def neg_equal_iff_equal numeral_eq_iff)
+
+lemma numeral_neq_neg_numeral: "numeral m \<noteq> neg_numeral n"
+  unfolding neg_numeral_def eq_neg_iff_add_eq_0
+  by (simp add: numeral_plus_numeral)
+
+lemma neg_numeral_neq_numeral: "neg_numeral m \<noteq> numeral n"
+  by (rule numeral_neq_neg_numeral [symmetric])
+
+lemma zero_neq_neg_numeral: "0 \<noteq> neg_numeral n"
+  unfolding neg_numeral_def neg_0_equal_iff_equal by simp
+
+lemma neg_numeral_neq_zero: "neg_numeral n \<noteq> 0"
+  unfolding neg_numeral_def neg_equal_0_iff_equal by simp
+
+lemma one_neq_neg_numeral: "1 \<noteq> neg_numeral n"
+  using numeral_neq_neg_numeral [of One n] by (simp add: numeral_One)
+
+lemma neg_numeral_neq_one: "neg_numeral n \<noteq> 1"
+  using neg_numeral_neq_numeral [of n One] by (simp add: numeral_One)
+
+lemmas eq_neg_numeral_simps [simp] =
+  neg_numeral_eq_iff
+  numeral_neq_neg_numeral neg_numeral_neq_numeral
+  one_neq_neg_numeral neg_numeral_neq_one
+  zero_neq_neg_numeral neg_numeral_neq_zero
+
+end
+
+subsubsection {*
+  Structures with negation and order: class @{text linordered_idom}
+*}
+
+context linordered_idom
+begin
+
+subclass ring_char_0 ..
+
+lemma neg_numeral_le_iff: "neg_numeral m \<le> neg_numeral n \<longleftrightarrow> n \<le> m"
+  by (simp only: neg_numeral_def neg_le_iff_le numeral_le_iff)
+
+lemma neg_numeral_less_iff: "neg_numeral m < neg_numeral n \<longleftrightarrow> n < m"
+  by (simp only: neg_numeral_def neg_less_iff_less numeral_less_iff)
+
+lemma neg_numeral_less_zero: "neg_numeral n < 0"
+  by (simp only: neg_numeral_def neg_less_0_iff_less zero_less_numeral)
+
+lemma neg_numeral_le_zero: "neg_numeral n \<le> 0"
+  by (simp only: neg_numeral_def neg_le_0_iff_le zero_le_numeral)
+
+lemma not_zero_less_neg_numeral: "\<not> 0 < neg_numeral n"
+  by (simp only: not_less neg_numeral_le_zero)
+
+lemma not_zero_le_neg_numeral: "\<not> 0 \<le> neg_numeral n"
+  by (simp only: not_le neg_numeral_less_zero)
+
+lemma neg_numeral_less_numeral: "neg_numeral m < numeral n"
+  using neg_numeral_less_zero zero_less_numeral by (rule less_trans)
+
+lemma neg_numeral_le_numeral: "neg_numeral m \<le> numeral n"
+  by (simp only: less_imp_le neg_numeral_less_numeral)
+
+lemma not_numeral_less_neg_numeral: "\<not> numeral m < neg_numeral n"
+  by (simp only: not_less neg_numeral_le_numeral)
+
+lemma not_numeral_le_neg_numeral: "\<not> numeral m \<le> neg_numeral n"
+  by (simp only: not_le neg_numeral_less_numeral)
+  
+lemma neg_numeral_less_one: "neg_numeral m < 1"
+  by (rule neg_numeral_less_numeral [of m One, unfolded numeral_One])
+
+lemma neg_numeral_le_one: "neg_numeral m \<le> 1"
+  by (rule neg_numeral_le_numeral [of m One, unfolded numeral_One])
+
+lemma not_one_less_neg_numeral: "\<not> 1 < neg_numeral m"
+  by (simp only: not_less neg_numeral_le_one)
+
+lemma not_one_le_neg_numeral: "\<not> 1 \<le> neg_numeral m"
+  by (simp only: not_le neg_numeral_less_one)
+
+lemma sub_non_negative:
+  "sub n m \<ge> 0 \<longleftrightarrow> n \<ge> m"
+  by (simp only: sub_def le_diff_eq) simp
+
+lemma sub_positive:
+  "sub n m > 0 \<longleftrightarrow> n > m"
+  by (simp only: sub_def less_diff_eq) simp
+
+lemma sub_non_positive:
+  "sub n m \<le> 0 \<longleftrightarrow> n \<le> m"
+  by (simp only: sub_def diff_le_eq) simp
+
+lemma sub_negative:
+  "sub n m < 0 \<longleftrightarrow> n < m"
+  by (simp only: sub_def diff_less_eq) simp
+
+lemmas le_neg_numeral_simps [simp] =
+  neg_numeral_le_iff
+  neg_numeral_le_numeral not_numeral_le_neg_numeral
+  neg_numeral_le_zero not_zero_le_neg_numeral
+  neg_numeral_le_one not_one_le_neg_numeral
+
+lemmas less_neg_numeral_simps [simp] =
+  neg_numeral_less_iff
+  neg_numeral_less_numeral not_numeral_less_neg_numeral
+  neg_numeral_less_zero not_zero_less_neg_numeral
+  neg_numeral_less_one not_one_less_neg_numeral
+
+lemma abs_numeral [simp]: "abs (numeral n) = numeral n"
+  by simp
+
+lemma abs_neg_numeral [simp]: "abs (neg_numeral n) = numeral n"
+  by (simp only: neg_numeral_def abs_minus_cancel abs_numeral)
+
+end
+
+subsubsection {*
+  Natural numbers
+*}
+
+lemma Suc_numeral [simp]: "Suc (numeral n) = numeral (n + One)"
+  unfolding numeral_plus_one [symmetric] by simp
+
+lemma nat_number:
+  "1 = Suc 0"
+  "numeral One = Suc 0"
+  "numeral (Bit0 n) = Suc (numeral (BitM n))"
+  "numeral (Bit1 n) = Suc (numeral (Bit0 n))"
+  by (simp_all add: numeral.simps BitM_plus_one)
+
+subsubsection {*
+  Structures with exponentiation
+*}
+
+context semiring_numeral
+begin
+
+lemma numeral_sqr: "numeral (sqr n) = numeral n * numeral n"
+  by (simp add: sqr_conv_mult numeral_mult)
+
+lemma numeral_pow: "numeral (pow m n) = numeral m ^ numeral n"
+  by (induct n, simp_all add: numeral_class.numeral.simps
+    power_add numeral_sqr numeral_mult)
+
+lemma power_numeral [simp]: "numeral m ^ numeral n = numeral (pow m n)"
+  by (rule numeral_pow [symmetric])
+
+end
+
+context semiring_1
+begin
+
+lemma power_zero_numeral [simp]: "(0::'a) ^ numeral n = 0"
+  by (induct n, simp_all add: numeral_class.numeral.simps power_add)
+
+end
+
+context ring_1
+begin
+
+lemma power_minus_Bit0: "(- x) ^ numeral (Bit0 n) = x ^ numeral (Bit0 n)"
+  by (induct n, simp_all add: numeral_class.numeral.simps power_add)
+
+lemma power_minus_Bit1: "(- x) ^ numeral (Bit1 n) = - (x ^ numeral (Bit1 n))"
+  by (simp only: nat_number(4) power_Suc power_minus_Bit0 mult_minus_left)
+
+lemma power_neg_numeral_Bit0 [simp]:
+  "neg_numeral m ^ numeral (Bit0 n) = numeral (pow m (Bit0 n))"
+  by (simp only: neg_numeral_def power_minus_Bit0 power_numeral)
+
+lemma power_neg_numeral_Bit1 [simp]:
+  "neg_numeral m ^ numeral (Bit1 n) = neg_numeral (pow m (Bit1 n))"
+  by (simp only: neg_numeral_def power_minus_Bit1 power_numeral pow.simps)
+
+end
+
+subsection {* Numeral equations as default simplification rules *}
+
+declare (in numeral) numeral_One [simp]
+declare (in numeral) numeral_plus_numeral [simp]
+declare (in numeral) add_numeral_special [simp]
+declare (in neg_numeral) add_neg_numeral_simps [simp]
+declare (in neg_numeral) add_neg_numeral_special [simp]
+declare (in neg_numeral) diff_numeral_simps [simp]
+declare (in neg_numeral) diff_numeral_special [simp]
+declare (in semiring_numeral) numeral_times_numeral [simp]
+declare (in ring_1) mult_neg_numeral_simps [simp]
+
+subsection {* Setting up simprocs *}
+
+lemma numeral_reorient:
+  "(numeral w = x) = (x = numeral w)"
+  by auto
+
+lemma mult_numeral_1: "Numeral1 * a = (a::'a::semiring_numeral)"
+  by simp
+
+lemma mult_numeral_1_right: "a * Numeral1 = (a::'a::semiring_numeral)"
+  by simp
+
+lemma divide_numeral_1: "a / Numeral1 = (a::'a::field)"
+  by simp
+
+lemma inverse_numeral_1:
+  "inverse Numeral1 = (Numeral1::'a::division_ring)"
+  by simp
+
+text{*Theorem lists for the cancellation simprocs. The use of a numary
+numeral for 1 reduces the number of special cases.*}
+
+lemmas mult_1s =
+  mult_numeral_1 mult_numeral_1_right 
+  mult_minus1 mult_minus1_right
+
+
+subsubsection {* Simplification of arithmetic operations on integer constants. *}
+
+lemmas arith_special = (* already declared simp above *)
+  add_numeral_special add_neg_numeral_special
+  diff_numeral_special minus_one
+
+(* rules already in simpset *)
+lemmas arith_extra_simps =
+  numeral_plus_numeral add_neg_numeral_simps add_0_left add_0_right
+  minus_numeral minus_neg_numeral minus_zero minus_one
+  diff_numeral_simps diff_0 diff_0_right
+  numeral_times_numeral mult_neg_numeral_simps
+  mult_zero_left mult_zero_right
+  abs_numeral abs_neg_numeral
+
+text {*
+  For making a minimal simpset, one must include these default simprules.
+  Also include @{text simp_thms}.
+*}
+
+lemmas arith_simps =
+  add_num_simps mult_num_simps sub_num_simps
+  BitM.simps dbl_simps dbl_inc_simps dbl_dec_simps
+  abs_zero abs_one arith_extra_simps
+
+text {* Simplification of relational operations *}
+
+lemmas eq_numeral_extra =
+  zero_neq_one one_neq_zero
+
+lemmas rel_simps =
+  le_num_simps less_num_simps eq_num_simps
+  le_numeral_simps le_neg_numeral_simps le_numeral_extra
+  less_numeral_simps less_neg_numeral_simps less_numeral_extra
+  eq_numeral_simps eq_neg_numeral_simps eq_numeral_extra
+
+
+subsubsection {* Simplification of arithmetic when nested to the right. *}
+
+lemma add_numeral_left [simp]:
+  "numeral v + (numeral w + z) = (numeral(v + w) + z)"
+  by (simp_all add: add_assoc [symmetric])
+
+lemma add_neg_numeral_left [simp]:
+  "numeral v + (neg_numeral w + y) = (sub v w + y)"
+  "neg_numeral v + (numeral w + y) = (sub w v + y)"
+  "neg_numeral v + (neg_numeral w + y) = (neg_numeral(v + w) + y)"
+  by (simp_all add: add_assoc [symmetric])
+
+lemma mult_numeral_left [simp]:
+  "numeral v * (numeral w * z) = (numeral(v * w) * z :: 'a::semiring_numeral)"
+  "neg_numeral v * (numeral w * y) = (neg_numeral(v * w) * y :: 'b::ring_1)"
+  "numeral v * (neg_numeral w * y) = (neg_numeral(v * w) * y :: 'b::ring_1)"
+  "neg_numeral v * (neg_numeral w * y) = (numeral(v * w) * y :: 'b::ring_1)"
+  by (simp_all add: mult_assoc [symmetric])
+
+hide_const (open) One Bit0 Bit1 BitM inc pow sqr sub dbl dbl_inc dbl_dec
+
+subsection {* code module namespace *}
+
+code_modulename SML
+  Numeral Arith
+
+code_modulename OCaml
+  Numeral Arith
+
+code_modulename Haskell
+  Numeral Arith
+
+end
--- a/src/HOL/Number_Theory/Primes.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Number_Theory/Primes.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -206,7 +206,7 @@
     "prime (p::nat) \<longleftrightarrow> p > 1 \<and> (\<forall>n \<in> set [2..<p]. \<not> n dvd p)"
   by (auto simp add: prime_nat_code)
 
-lemmas prime_nat_simp_number_of [simp] = prime_nat_simp [of "number_of m"] for m
+lemmas prime_nat_simp_numeral [simp] = prime_nat_simp [of "numeral m"] for m
 
 lemma prime_int_code [code]:
   "prime (p::int) \<longleftrightarrow> p > 1 \<and> (\<forall>n \<in> {1<..<p}. ~ n dvd p)" (is "?L = ?R")
@@ -222,7 +222,7 @@
 lemma prime_int_simp: "prime (p::int) \<longleftrightarrow> p > 1 \<and> (\<forall>n \<in> set [2..p - 1]. ~ n dvd p)"
   by (auto simp add: prime_int_code)
 
-lemmas prime_int_simp_number_of [simp] = prime_int_simp [of "number_of m"] for m
+lemmas prime_int_simp_numeral [simp] = prime_int_simp [of "numeral m"] for m
 
 lemma two_is_prime_nat [simp]: "prime (2::nat)"
   by simp
--- a/src/HOL/Numeral_Simprocs.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Numeral_Simprocs.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -14,8 +14,8 @@
   ("Tools/nat_numeral_simprocs.ML")
 begin
 
-declare split_div [of _ _ "number_of k", arith_split] for k
-declare split_mod [of _ _ "number_of k", arith_split] for k
+declare split_div [of _ _ "numeral k", arith_split] for k
+declare split_mod [of _ _ "numeral k", arith_split] for k
 
 text {* For @{text combine_numerals} *}
 
@@ -98,72 +98,74 @@
   ("(a::'a::comm_semiring_1_cancel) * b") =
   {* fn phi => Numeral_Simprocs.assoc_fold *}
 
+(* TODO: see whether the type class can be generalized further *)
 simproc_setup int_combine_numerals
-  ("(i::'a::number_ring) + j" | "(i::'a::number_ring) - j") =
+  ("(i::'a::comm_ring_1) + j" | "(i::'a::comm_ring_1) - j") =
   {* fn phi => Numeral_Simprocs.combine_numerals *}
 
 simproc_setup field_combine_numerals
-  ("(i::'a::{field_inverse_zero,ring_char_0,number_ring}) + j"
-  |"(i::'a::{field_inverse_zero,ring_char_0,number_ring}) - j") =
+  ("(i::'a::{field_inverse_zero,ring_char_0}) + j"
+  |"(i::'a::{field_inverse_zero,ring_char_0}) - j") =
   {* fn phi => Numeral_Simprocs.field_combine_numerals *}
 
 simproc_setup inteq_cancel_numerals
-  ("(l::'a::number_ring) + m = n"
-  |"(l::'a::number_ring) = m + n"
-  |"(l::'a::number_ring) - m = n"
-  |"(l::'a::number_ring) = m - n"
-  |"(l::'a::number_ring) * m = n"
-  |"(l::'a::number_ring) = m * n"
-  |"- (l::'a::number_ring) = m"
-  |"(l::'a::number_ring) = - m") =
+  ("(l::'a::comm_ring_1) + m = n"
+  |"(l::'a::comm_ring_1) = m + n"
+  |"(l::'a::comm_ring_1) - m = n"
+  |"(l::'a::comm_ring_1) = m - n"
+  |"(l::'a::comm_ring_1) * m = n"
+  |"(l::'a::comm_ring_1) = m * n"
+  |"- (l::'a::comm_ring_1) = m"
+  |"(l::'a::comm_ring_1) = - m") =
   {* fn phi => Numeral_Simprocs.eq_cancel_numerals *}
 
 simproc_setup intless_cancel_numerals
-  ("(l::'a::{linordered_idom,number_ring}) + m < n"
-  |"(l::'a::{linordered_idom,number_ring}) < m + n"
-  |"(l::'a::{linordered_idom,number_ring}) - m < n"
-  |"(l::'a::{linordered_idom,number_ring}) < m - n"
-  |"(l::'a::{linordered_idom,number_ring}) * m < n"
-  |"(l::'a::{linordered_idom,number_ring}) < m * n"
-  |"- (l::'a::{linordered_idom,number_ring}) < m"
-  |"(l::'a::{linordered_idom,number_ring}) < - m") =
+  ("(l::'a::linordered_idom) + m < n"
+  |"(l::'a::linordered_idom) < m + n"
+  |"(l::'a::linordered_idom) - m < n"
+  |"(l::'a::linordered_idom) < m - n"
+  |"(l::'a::linordered_idom) * m < n"
+  |"(l::'a::linordered_idom) < m * n"
+  |"- (l::'a::linordered_idom) < m"
+  |"(l::'a::linordered_idom) < - m") =
   {* fn phi => Numeral_Simprocs.less_cancel_numerals *}
 
 simproc_setup intle_cancel_numerals
-  ("(l::'a::{linordered_idom,number_ring}) + m \<le> n"
-  |"(l::'a::{linordered_idom,number_ring}) \<le> m + n"
-  |"(l::'a::{linordered_idom,number_ring}) - m \<le> n"
-  |"(l::'a::{linordered_idom,number_ring}) \<le> m - n"
-  |"(l::'a::{linordered_idom,number_ring}) * m \<le> n"
-  |"(l::'a::{linordered_idom,number_ring}) \<le> m * n"
-  |"- (l::'a::{linordered_idom,number_ring}) \<le> m"
-  |"(l::'a::{linordered_idom,number_ring}) \<le> - m") =
+  ("(l::'a::linordered_idom) + m \<le> n"
+  |"(l::'a::linordered_idom) \<le> m + n"
+  |"(l::'a::linordered_idom) - m \<le> n"
+  |"(l::'a::linordered_idom) \<le> m - n"
+  |"(l::'a::linordered_idom) * m \<le> n"
+  |"(l::'a::linordered_idom) \<le> m * n"
+  |"- (l::'a::linordered_idom) \<le> m"
+  |"(l::'a::linordered_idom) \<le> - m") =
   {* fn phi => Numeral_Simprocs.le_cancel_numerals *}
 
 simproc_setup ring_eq_cancel_numeral_factor
-  ("(l::'a::{idom,ring_char_0,number_ring}) * m = n"
-  |"(l::'a::{idom,ring_char_0,number_ring}) = m * n") =
+  ("(l::'a::{idom,ring_char_0}) * m = n"
+  |"(l::'a::{idom,ring_char_0}) = m * n") =
   {* fn phi => Numeral_Simprocs.eq_cancel_numeral_factor *}
 
 simproc_setup ring_less_cancel_numeral_factor
-  ("(l::'a::{linordered_idom,number_ring}) * m < n"
-  |"(l::'a::{linordered_idom,number_ring}) < m * n") =
+  ("(l::'a::linordered_idom) * m < n"
+  |"(l::'a::linordered_idom) < m * n") =
   {* fn phi => Numeral_Simprocs.less_cancel_numeral_factor *}
 
 simproc_setup ring_le_cancel_numeral_factor
-  ("(l::'a::{linordered_idom,number_ring}) * m <= n"
-  |"(l::'a::{linordered_idom,number_ring}) <= m * n") =
+  ("(l::'a::linordered_idom) * m <= n"
+  |"(l::'a::linordered_idom) <= m * n") =
   {* fn phi => Numeral_Simprocs.le_cancel_numeral_factor *}
 
+(* TODO: remove comm_ring_1 constraint if possible *)
 simproc_setup int_div_cancel_numeral_factors
-  ("((l::'a::{semiring_div,ring_char_0,number_ring}) * m) div n"
-  |"(l::'a::{semiring_div,ring_char_0,number_ring}) div (m * n)") =
+  ("((l::'a::{semiring_div,comm_ring_1,ring_char_0}) * m) div n"
+  |"(l::'a::{semiring_div,comm_ring_1,ring_char_0}) div (m * n)") =
   {* fn phi => Numeral_Simprocs.div_cancel_numeral_factor *}
 
 simproc_setup divide_cancel_numeral_factor
-  ("((l::'a::{field_inverse_zero,ring_char_0,number_ring}) * m) / n"
-  |"(l::'a::{field_inverse_zero,ring_char_0,number_ring}) / (m * n)"
-  |"((number_of v)::'a::{field_inverse_zero,ring_char_0,number_ring}) / (number_of w)") =
+  ("((l::'a::{field_inverse_zero,ring_char_0}) * m) / n"
+  |"(l::'a::{field_inverse_zero,ring_char_0}) / (m * n)"
+  |"((numeral v)::'a::{field_inverse_zero,ring_char_0}) / (numeral w)") =
   {* fn phi => Numeral_Simprocs.divide_cancel_numeral_factor *}
 
 simproc_setup ring_eq_cancel_factor
@@ -270,19 +272,25 @@
   ("((l::nat) * m) dvd n" | "(l::nat) dvd (m * n)") =
   {* fn phi => Nat_Numeral_Simprocs.dvd_cancel_factor *}
 
+(* FIXME: duplicate rule warnings for:
+  ring_distribs
+  numeral_plus_numeral numeral_times_numeral
+  numeral_eq_iff numeral_less_iff numeral_le_iff
+  numeral_neq_zero zero_neq_numeral zero_less_numeral
+  if_True if_False *)
 declaration {* 
-  K (Lin_Arith.add_simps (@{thms neg_simps} @ [@{thm Suc_nat_number_of}, @{thm int_nat_number_of}])
-  #> Lin_Arith.add_simps (@{thms ring_distribs} @ [@{thm Let_number_of}, @{thm Let_0}, @{thm Let_1},
+  K (Lin_Arith.add_simps ([@{thm Suc_numeral}, @{thm int_numeral}])
+  #> Lin_Arith.add_simps (@{thms ring_distribs} @ [@{thm Let_numeral}, @{thm Let_neg_numeral}, @{thm Let_0}, @{thm Let_1},
      @{thm nat_0}, @{thm nat_1},
-     @{thm add_nat_number_of}, @{thm diff_nat_number_of}, @{thm mult_nat_number_of},
-     @{thm eq_nat_number_of}, @{thm less_nat_number_of}, @{thm le_number_of_eq_not_less},
-     @{thm le_Suc_number_of}, @{thm le_number_of_Suc},
-     @{thm less_Suc_number_of}, @{thm less_number_of_Suc},
-     @{thm Suc_eq_number_of}, @{thm eq_number_of_Suc},
+     @{thm numeral_plus_numeral}, @{thm diff_nat_numeral}, @{thm numeral_times_numeral},
+     @{thm numeral_eq_iff}, @{thm numeral_less_iff}, @{thm numeral_le_iff},
+     @{thm le_Suc_numeral}, @{thm le_numeral_Suc},
+     @{thm less_Suc_numeral}, @{thm less_numeral_Suc},
+     @{thm Suc_eq_numeral}, @{thm eq_numeral_Suc},
      @{thm mult_Suc}, @{thm mult_Suc_right},
      @{thm add_Suc}, @{thm add_Suc_right},
-     @{thm eq_number_of_0}, @{thm eq_0_number_of}, @{thm less_0_number_of},
-     @{thm of_int_number_of_eq}, @{thm of_nat_number_of_eq}, @{thm nat_number_of},
+     @{thm numeral_neq_zero}, @{thm zero_neq_numeral}, @{thm zero_less_numeral},
+     @{thm of_int_numeral}, @{thm of_nat_numeral}, @{thm nat_numeral},
      @{thm if_True}, @{thm if_False}])
   #> Lin_Arith.add_simprocs
       [@{simproc semiring_assoc_fold},
--- a/src/HOL/Parity.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Parity.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -45,9 +45,11 @@
 
 lemma odd_1_nat [simp]: "odd (1::nat)" by presburger
 
-declare even_def[of "number_of v", simp] for v
+(* TODO: proper simp rules for Num.Bit0, Num.Bit1 *)
+declare even_def[of "numeral v", simp] for v
+declare even_def[of "neg_numeral v", simp] for v
 
-declare even_nat_def[of "number_of v", simp] for v
+declare even_nat_def[of "numeral v", simp] for v
 
 subsection {* Even and odd are mutually exclusive *}
 
@@ -197,18 +199,18 @@
   using minus_one_even_odd_power by blast
 
 lemma neg_one_even_odd_power:
-     "(even x --> (-1::'a::{number_ring})^x = 1) &
+     "(even x --> (-1::'a::{comm_ring_1})^x = 1) &
       (odd x --> (-1::'a)^x = -1)"
   apply (induct x)
   apply (simp, simp)
   done
 
 lemma neg_one_even_power [simp]:
-    "even x ==> (-1::'a::{number_ring})^x = 1"
+    "even x ==> (-1::'a::{comm_ring_1})^x = 1"
   using neg_one_even_odd_power by blast
 
 lemma neg_one_odd_power [simp]:
-    "odd x ==> (-1::'a::{number_ring})^x = -1"
+    "odd x ==> (-1::'a::{comm_ring_1})^x = -1"
   using neg_one_even_odd_power by blast
 
 lemma neg_power_if:
@@ -347,27 +349,28 @@
 
 text {* Simplify, when the exponent is a numeral *}
 
-lemmas power_0_left_number_of = power_0_left [of "number_of w"] for w
-declare power_0_left_number_of [simp]
+lemma power_0_left_numeral [simp]:
+  "0 ^ numeral w = (0::'a::{power,semiring_0})"
+by (simp add: power_0_left)
 
-lemmas zero_le_power_eq_number_of [simp] =
-    zero_le_power_eq [of _ "number_of w"] for w
+lemmas zero_le_power_eq_numeral [simp] =
+    zero_le_power_eq [of _ "numeral w"] for w
 
-lemmas zero_less_power_eq_number_of [simp] =
-    zero_less_power_eq [of _ "number_of w"] for w
+lemmas zero_less_power_eq_numeral [simp] =
+    zero_less_power_eq [of _ "numeral w"] for w
 
-lemmas power_le_zero_eq_number_of [simp] =
-    power_le_zero_eq [of _ "number_of w"] for w
+lemmas power_le_zero_eq_numeral [simp] =
+    power_le_zero_eq [of _ "numeral w"] for w
 
-lemmas power_less_zero_eq_number_of [simp] =
-    power_less_zero_eq [of _ "number_of w"] for w
+lemmas power_less_zero_eq_numeral [simp] =
+    power_less_zero_eq [of _ "numeral w"] for w
 
-lemmas zero_less_power_nat_eq_number_of [simp] =
-    zero_less_power_nat_eq [of _ "number_of w"] for w
+lemmas zero_less_power_nat_eq_numeral [simp] =
+    zero_less_power_nat_eq [of _ "numeral w"] for w
 
-lemmas power_eq_0_iff_number_of [simp] = power_eq_0_iff [of _ "number_of w"] for w
+lemmas power_eq_0_iff_numeral [simp] = power_eq_0_iff [of _ "numeral w"] for w
 
-lemmas power_even_abs_number_of [simp] = power_even_abs [of "number_of w" _] for w
+lemmas power_even_abs_numeral [simp] = power_even_abs [of "numeral w" _] for w
 
 
 subsection {* An Equivalence for @{term [source] "0 \<le> a^n"} *}
--- a/src/HOL/Plain.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Plain.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -1,7 +1,7 @@
 header {* Plain HOL *}
 
 theory Plain
-imports Datatype FunDef Extraction Metis
+imports Datatype FunDef Extraction Metis Num
 begin
 
 text {*
--- a/src/HOL/Predicate_Compile_Examples/Predicate_Compile_Tests.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Predicate_Compile_Examples/Predicate_Compile_Tests.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -334,7 +334,7 @@
 code_pred [dseq] one_or_two .
 code_pred [random_dseq] one_or_two .
 thm one_or_two.dseq_equation
-values [expected "{Suc 0::nat, 2::nat}"] "{x. one_or_two x}"
+values [expected "{1::nat, 2::nat}"] "{x. one_or_two x}"
 values [random_dseq 0,0,10] 3 "{x. one_or_two x}"
 
 inductive one_or_two' :: "nat => bool"
@@ -442,7 +442,7 @@
 values "{ys. append [0, Suc 0, 2] ys [0, Suc 0, 2, 17, 0, 5]}"
 
 values [expected "{}" dseq 0] 10 "{(xs, ys). append xs ys [1, 2, 3, 4, (5::nat)]}"
-values [expected "{(([]::nat list), [Suc 0, 2, 3, 4, (5::nat)])}" dseq 1] 10 "{(xs, ys). append xs ys [1, 2, 3, 4, (5::nat)]}"
+values [expected "{(([]::nat list), [1, 2, 3, 4, (5::nat)])}" dseq 1] 10 "{(xs, ys). append xs ys [1, 2, 3, 4, (5::nat)]}"
 values [dseq 4] 10 "{(xs, ys). append xs ys [1, 2, 3, 4, (5::nat)]}"
 values [dseq 6] 10 "{(xs, ys). append xs ys [1, 2, 3, 4, (5::nat)]}"
 values [random_dseq 1, 1, 4] 10 "{(xs, ys). append xs ys [1, 2, 3, 4, (5::nat)]}"
@@ -1241,8 +1241,8 @@
 values [expected "{2::nat}"] "{x. plus_nat_test x 7 9}"
 values [expected "{}"] "{x. plus_nat_test x 9 7}"
 values [expected "{(0::nat,0::nat)}"] "{(x, y). plus_nat_test x y 0}"
-values [expected "{(0, Suc 0), (Suc 0, 0)}"] "{(x, y). plus_nat_test x y 1}"
-values [expected "{(0, 5), (4, Suc 0), (3, 2), (2, 3), (Suc 0, 4), (5, 0)}"]
+values [expected "{(0::nat, 1::nat), (1, 0)}"] "{(x, y). plus_nat_test x y 1}"
+values [expected "{(0::nat, 5::nat), (4, 1), (3, 2), (2, 3), (1, 4), (5, 0)}"]
   "{(x, y). plus_nat_test x y 5}"
 
 inductive minus_nat_test :: "nat => nat => nat => bool"
@@ -1259,7 +1259,7 @@
 values [expected "{5::nat}"] "{z. minus_nat_test 7 2 z}"
 values [expected "{16::nat}"] "{x. minus_nat_test x 7 9}"
 values [expected "{16::nat}"] "{x. minus_nat_test x 9 7}"
-values [expected "{0, Suc 0, 2, 3}"] "{x. minus_nat_test x 3 0}"
+values [expected "{0::nat, 1, 2, 3}"] "{x. minus_nat_test x 3 0}"
 values [expected "{0::nat}"] "{x. minus_nat_test x 0 0}"
 
 subsection {* Examples on int *}
--- a/src/HOL/Presburger.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Presburger.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -374,18 +374,16 @@
   ((y \<le> x \<longrightarrow> P (int x - int y)) \<and> (x < y \<longrightarrow> P 0))"
   by (cases "y \<le> x") (simp_all add: zdiff_int)
 
-lemma number_of1: "(0::int) <= number_of n \<Longrightarrow> (0::int) <= number_of (Int.Bit0 n) \<and> (0::int) <= number_of (Int.Bit1 n)"
-by simp
-
-lemma number_of2: "(0::int) <= Numeral0" by simp
-
 text {*
   \medskip Specific instances of congruence rules, to prevent
   simplifier from looping. *}
 
-theorem imp_le_cong: "(0 <= x \<Longrightarrow> P = P') \<Longrightarrow> (0 <= (x::int) \<longrightarrow> P) = (0 <= x \<longrightarrow> P')" by simp
+theorem imp_le_cong:
+  "\<lbrakk>x = x'; 0 \<le> x' \<Longrightarrow> P = P'\<rbrakk> \<Longrightarrow> (0 \<le> (x::int) \<longrightarrow> P) = (0 \<le> x' \<longrightarrow> P')"
+  by simp
 
-theorem conj_le_cong: "(0 <= x \<Longrightarrow> P = P') \<Longrightarrow> (0 <= (x::int) \<and> P) = (0 <= x \<and> P')" 
+theorem conj_le_cong:
+  "\<lbrakk>x = x'; 0 \<le> x' \<Longrightarrow> P = P'\<rbrakk> \<Longrightarrow> (0 \<le> (x::int) \<and> P) = (0 \<le> x' \<and> P')"
   by (simp cong: conj_cong)
 
 use "Tools/Qelim/cooper.ML"
--- a/src/HOL/Quickcheck_Examples/Quickcheck_Narrowing_Examples.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Quickcheck_Examples/Quickcheck_Narrowing_Examples.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -79,15 +79,14 @@
 quickcheck[tester = narrowing, finite_types = false, default_type = nat, expect = counterexample]
 oops
 
-(* FIXME: integer has strange representation! *)
 lemma "rev xs = xs"
 quickcheck[tester = narrowing, finite_types = false, default_type = int, expect = counterexample]
 oops
-(*
+
 lemma "rev xs = xs"
   quickcheck[tester = narrowing, finite_types = true, expect = counterexample]
 oops
-*)
+
 subsection {* Simple examples with functions *}
 
 lemma "map f xs = map g xs"
--- a/src/HOL/Quickcheck_Narrowing.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Quickcheck_Narrowing.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -70,34 +70,15 @@
   "HOL.equal k l \<longleftrightarrow> HOL.equal (int_of k) (int_of l)"
 
 instance proof
-qed (auto simp add: equal_code_int_def equal_int_def eq_int_refl)
+qed (auto simp add: equal_code_int_def equal_int_def equal_int_refl)
 
 end
 
-instantiation code_int :: number
-begin
-
-definition
-  "number_of = of_int"
-
-instance ..
-
-end
-
-lemma int_of_number [simp]:
-  "int_of (number_of k) = number_of k"
-  by (simp add: number_of_code_int_def number_of_is_id)
-
-
 definition nat_of :: "code_int => nat"
 where
   "nat_of i = nat (int_of i)"
-
-
-code_datatype "number_of \<Colon> int \<Rightarrow> code_int"
   
-  
-instantiation code_int :: "{minus, linordered_semidom, semiring_div, linorder}"
+instantiation code_int :: "{minus, linordered_semidom, semiring_div, neg_numeral, linorder}"
 begin
 
 definition [simp, code del]:
@@ -110,6 +91,9 @@
   "n + m = of_int (int_of n + int_of m)"
 
 definition [simp, code del]:
+  "- n = of_int (- int_of n)"
+
+definition [simp, code del]:
   "n - m = of_int (int_of n - int_of m)"
 
 definition [simp, code del]:
@@ -127,34 +111,43 @@
 definition [simp, code del]:
   "n < m \<longleftrightarrow> int_of n < int_of m"
 
-
 instance proof
 qed (auto simp add: code_int left_distrib zmult_zless_mono2)
 
 end
 
-lemma zero_code_int_code [code, code_unfold]:
-  "(0\<Colon>code_int) = Numeral0"
-  by (simp add: number_of_code_int_def Pls_def)
+lemma int_of_numeral [simp]:
+  "int_of (numeral k) = numeral k"
+  by (induct k) (simp_all only: numeral.simps plus_code_int_def
+    one_code_int_def of_int_inverse UNIV_I)
+
+definition Num :: "num \<Rightarrow> code_int"
+  where [code_abbrev]: "Num = numeral"
+
+lemma [code_abbrev]:
+  "- numeral k = (neg_numeral k :: code_int)"
+  by (unfold neg_numeral_def) simp
+
+code_datatype "0::code_int" Num
 
 lemma one_code_int_code [code, code_unfold]:
   "(1\<Colon>code_int) = Numeral1"
-  by (simp add: number_of_code_int_def Pls_def Bit1_def)
+  by (simp only: numeral.simps)
 
-definition div_mod_code_int :: "code_int \<Rightarrow> code_int \<Rightarrow> code_int \<times> code_int" where
-  [code del]: "div_mod_code_int n m = (n div m, n mod m)"
+definition div_mod :: "code_int \<Rightarrow> code_int \<Rightarrow> code_int \<times> code_int" where
+  [code del]: "div_mod n m = (n div m, n mod m)"
 
 lemma [code]:
-  "div_mod_code_int n m = (if m = 0 then (0, n) else (n div m, n mod m))"
-  unfolding div_mod_code_int_def by auto
+  "div_mod n m = (if m = 0 then (0, n) else (n div m, n mod m))"
+  unfolding div_mod_def by auto
 
 lemma [code]:
-  "n div m = fst (div_mod_code_int n m)"
-  unfolding div_mod_code_int_def by simp
+  "n div m = fst (div_mod n m)"
+  unfolding div_mod_def by simp
 
 lemma [code]:
-  "n mod m = snd (div_mod_code_int n m)"
-  unfolding div_mod_code_int_def by simp
+  "n mod m = snd (div_mod n m)"
+  unfolding div_mod_def by simp
 
 lemma int_of_code [code]:
   "int_of k = (if k = 0 then 0
@@ -172,9 +165,12 @@
 code_instance code_numeral :: equal
   (Haskell_Quickcheck -)
 
-setup {* fold (Numeral.add_code @{const_name number_code_int_inst.number_of_code_int}
+setup {* fold (Numeral.add_code @{const_name Num}
   false Code_Printer.literal_numeral) ["Haskell_Quickcheck"]  *}
 
+code_type code_int
+  (Haskell_Quickcheck "Int")
+
 code_const "0 \<Colon> code_int"
   (Haskell_Quickcheck "0")
 
@@ -182,24 +178,23 @@
   (Haskell_Quickcheck "1")
 
 code_const "minus \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> code_int"
-  (Haskell_Quickcheck "(_/ -/ _)")
+  (Haskell_Quickcheck infixl 6 "-")
 
-code_const div_mod_code_int
+code_const div_mod
   (Haskell_Quickcheck "divMod")
 
 code_const "HOL.equal \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> bool"
   (Haskell_Quickcheck infix 4 "==")
 
-code_const "op \<le> \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> bool"
+code_const "less_eq \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> bool"
   (Haskell_Quickcheck infix 4 "<=")
 
-code_const "op < \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> bool"
+code_const "less \<Colon> code_int \<Rightarrow> code_int \<Rightarrow> bool"
   (Haskell_Quickcheck infix 4 "<")
 
-code_type code_int
-  (Haskell_Quickcheck "Int")
+code_abort of_int
 
-code_abort of_int
+hide_const (open) Num div_mod
 
 subsubsection {* Narrowing's deep representation of types and terms *}
 
--- a/src/HOL/Quotient_Examples/Quotient_Rat.thy	Sat Mar 24 16:27:04 2012 +0100
+++ b/src/HOL/Quotient_Examples/Quotient_Rat.thy	Sun Mar 25 20:15:39 2012 +0200
@@ -159,17 +159,6 @@
   apply auto
   done
 
-instantiation rat :: number_ring
-begin
-
-definition
-  rat_number_of_def: "number_of w = Fract w 1"
-