Polymorphic treatment of binary arithmetic using axclasses
authorpaulson
Sun Feb 15 10:46:37 2004 +0100 (2004-02-15)
changeset 14387e96d5c42c4b0
parent 14386 ad1ffcc90162
child 14388 04f04408b99b
Polymorphic treatment of binary arithmetic using axclasses
doc-src/TutorialI/Types/document/Numbers.tex
doc-src/TutorialI/Types/document/Pairs.tex
src/HOL/Complex/CLim.ML
src/HOL/Complex/Complex.thy
src/HOL/Complex/ComplexArith0.ML
src/HOL/Complex/ComplexArith0.thy
src/HOL/Complex/ComplexBin.ML
src/HOL/Complex/ComplexBin.thy
src/HOL/Complex/NSCA.ML
src/HOL/Complex/NSCA.thy
src/HOL/Complex/NSComplex.thy
src/HOL/Complex/NSComplexArith.thy
src/HOL/Complex/NSComplexBin.ML
src/HOL/Complex/NSComplexBin.thy
src/HOL/Complex/NSInduct.thy
src/HOL/Complex/hcomplex_arith.ML
src/HOL/Hyperreal/HSeries.ML
src/HOL/Hyperreal/HyperArith.thy
src/HOL/Hyperreal/HyperDef.thy
src/HOL/Hyperreal/HyperPow.thy
src/HOL/Hyperreal/IntFloor.ML
src/HOL/Hyperreal/Integration.ML
src/HOL/Hyperreal/Lim.ML
src/HOL/Hyperreal/Lim.thy
src/HOL/Hyperreal/NSA.thy
src/HOL/Hyperreal/SEQ.ML
src/HOL/Hyperreal/Transcendental.ML
src/HOL/Hyperreal/hypreal_arith.ML
src/HOL/Integ/Bin.thy
src/HOL/Integ/IntArith.thy
src/HOL/Integ/IntDef.thy
src/HOL/Integ/IntDiv.thy
src/HOL/Integ/IntDiv_setup.ML
src/HOL/Integ/NatBin.thy
src/HOL/Integ/NatSimprocs.thy
src/HOL/Integ/int_arith1.ML
src/HOL/Integ/int_factor_simprocs.ML
src/HOL/Integ/nat_simprocs.ML
src/HOL/IsaMakefile
src/HOL/NumberTheory/Int2.thy
src/HOL/NumberTheory/IntPrimes.thy
src/HOL/NumberTheory/Quadratic_Reciprocity.thy
src/HOL/Numeral.thy
src/HOL/ROOT.ML
src/HOL/Real/PReal.thy
src/HOL/Real/RComplete.thy
src/HOL/Real/RatArith.thy
src/HOL/Real/Rational.thy
src/HOL/Real/RealArith.thy
src/HOL/Real/RealDef.thy
src/HOL/Real/RealPow.thy
src/HOL/Real/rat_arith.ML
src/HOL/Real/real_arith.ML
src/HOL/Ring_and_Field.thy
src/HOL/hologic.ML
src/Provers/Arith/assoc_fold.ML
src/Provers/Arith/cancel_numerals.ML
src/Provers/Arith/combine_numerals.ML
src/Provers/Arith/extract_common_term.ML
src/Pure/drule.ML
src/ZF/Integ/int_arith.ML
src/ZF/arith_data.ML
     1.1 --- a/doc-src/TutorialI/Types/document/Numbers.tex	Sat Feb 14 02:06:12 2004 +0100
     1.2 +++ b/doc-src/TutorialI/Types/document/Numbers.tex	Sun Feb 15 10:46:37 2004 +0100
     1.3 @@ -37,12 +37,12 @@
     1.4  %
     1.5  \begin{isamarkuptext}%
     1.6  \begin{isabelle}%
     1.7 -Numeral{\isadigit{0}}\ {\isacharequal}\ {\isadigit{0}}%
     1.8 +Numeral{\isadigit{0}}\ {\isacharequal}\ {\isacharparenleft}{\isadigit{0}}{\isasymColon}{\isacharprime}a{\isacharparenright}%
     1.9  \end{isabelle}
    1.10  \rulename{numeral_0_eq_0}
    1.11  
    1.12  \begin{isabelle}%
    1.13 -Numeral{\isadigit{1}}\ {\isacharequal}\ {\isadigit{1}}%
    1.14 +Numeral{\isadigit{1}}\ {\isacharequal}\ {\isacharparenleft}{\isadigit{1}}{\isasymColon}{\isacharprime}a{\isacharparenright}%
    1.15  \end{isabelle}
    1.16  \rulename{numeral_1_eq_1}
    1.17  
     2.1 --- a/doc-src/TutorialI/Types/document/Pairs.tex	Sat Feb 14 02:06:12 2004 +0100
     2.2 +++ b/doc-src/TutorialI/Types/document/Pairs.tex	Sun Feb 15 10:46:37 2004 +0100
     2.3 @@ -33,7 +33,7 @@
     2.4  \isa{case\ xs\ of\ {\isacharbrackleft}{\isacharbrackright}\ {\isasymRightarrow}\ {\isadigit{0}}\ {\isacharbar}\ {\isacharparenleft}x{\isacharcomma}\ y{\isacharparenright}\ {\isacharhash}\ zs\ {\isasymRightarrow}\ x\ {\isacharplus}\ y}\\
     2.5  \isa{{\isasymforall}{\isacharparenleft}x{\isacharcomma}y{\isacharparenright}{\isasymin}A{\isachardot}\ x{\isacharequal}y}\\
     2.6  \isa{{\isacharbraceleft}{\isacharparenleft}x{\isacharcomma}y{\isacharcomma}z{\isacharparenright}{\isachardot}\ x{\isacharequal}z{\isacharbraceright}}\\
     2.7 -\isa{{\isasymUnion}{\isacharparenleft}x{\isacharcomma}\ y{\isacharparenright}{\isasymin}A{\isachardot}\ {\isacharbraceleft}x\ {\isacharplus}\ y{\isacharbraceright}}
     2.8 +\isa{{\isasymUnion}\isactrlbsub {\isacharparenleft}x{\isacharcomma}\ y{\isacharparenright}{\isasymin}A\isactrlesub \ {\isacharbraceleft}x\ {\isacharplus}\ y{\isacharbraceright}}
     2.9  \end{quote}
    2.10  The intuitive meanings of these expressions should be obvious.
    2.11  Unfortunately, we need to know in more detail what the notation really stands
     3.1 --- a/src/HOL/Complex/CLim.ML	Sat Feb 14 02:06:12 2004 +0100
     3.2 +++ b/src/HOL/Complex/CLim.ML	Sun Feb 15 10:46:37 2004 +0100
     3.3 @@ -5,6 +5,20 @@
     3.4                    differentiation for complex functions
     3.5  *)
     3.6  
     3.7 +(*FIXME: MOVE these two to Complex.thy*)
     3.8 +Goal "(x + - a = (0::complex)) = (x=a)";
     3.9 +by (simp_tac (simpset() addsimps [diff_eq_eq,symmetric complex_diff_def]) 1);
    3.10 +qed "complex_add_minus_iff";
    3.11 +Addsimps [complex_add_minus_iff];
    3.12 +
    3.13 +Goal "(x+y = (0::complex)) = (y = -x)";
    3.14 +by Auto_tac;
    3.15 +by (dtac (sym RS (diff_eq_eq RS iffD2)) 1);
    3.16 +by Auto_tac;  
    3.17 +qed "complex_add_eq_0_iff";
    3.18 +AddIffs [complex_add_eq_0_iff];
    3.19 +
    3.20 +
    3.21  (*-----------------------------------------------------------------------*)
    3.22  (* Limit of complex to complex function                                               *)
    3.23  (*-----------------------------------------------------------------------*)
    3.24 @@ -1175,7 +1189,7 @@
    3.25  Goal "(ALL z. f z - f x = g z * (z - x)) & isNSContc g x & g x = l \
    3.26  \     ==> NSCDERIV f x :> l";
    3.27  by (auto_tac (claset(), 
    3.28 -              simpset() delsimprocs complex_cancel_factor
    3.29 +              simpset() delsimprocs field_cancel_factor
    3.30                          addsimps [NSCDERIV_iff2]));
    3.31  by (asm_full_simp_tac (simpset() addsimps [isNSContc_def]) 1);
    3.32  qed "CARAT_CDERIVD";
     4.1 --- a/src/HOL/Complex/Complex.thy	Sat Feb 14 02:06:12 2004 +0100
     4.2 +++ b/src/HOL/Complex/Complex.thy	Sun Feb 15 10:46:37 2004 +0100
     4.3 @@ -1,6 +1,7 @@
     4.4  (*  Title:       Complex.thy
     4.5      Author:      Jacques D. Fleuriot
     4.6      Copyright:   2001 University of Edinburgh
     4.7 +    Conversion to Isar and new proofs by Lawrence C Paulson, 2003/4
     4.8  *)
     4.9  
    4.10  header {* Complex Numbers: Rectangular and Polar Representations *}
    4.11 @@ -830,6 +831,143 @@
    4.12  done
    4.13  
    4.14  
    4.15 +subsection{*Numerals and Arithmetic*}
    4.16 +
    4.17 +instance complex :: number ..
    4.18 +
    4.19 +primrec (*the type constraint is essential!*)
    4.20 +  number_of_Pls: "number_of bin.Pls = 0"
    4.21 +  number_of_Min: "number_of bin.Min = - (1::complex)"
    4.22 +  number_of_BIT: "number_of(w BIT x) = (if x then 1 else 0) +
    4.23 +	                               (number_of w) + (number_of w)"
    4.24 +
    4.25 +declare number_of_Pls [simp del]
    4.26 +        number_of_Min [simp del]
    4.27 +        number_of_BIT [simp del]
    4.28 +
    4.29 +instance complex :: number_ring
    4.30 +proof
    4.31 +  show "Numeral0 = (0::complex)" by (rule number_of_Pls)
    4.32 +  show "-1 = - (1::complex)" by (rule number_of_Min)
    4.33 +  fix w :: bin and x :: bool
    4.34 +  show "(number_of (w BIT x) :: complex) =
    4.35 +        (if x then 1 else 0) + number_of w + number_of w"
    4.36 +    by (rule number_of_BIT)
    4.37 +qed
    4.38 +
    4.39 +
    4.40 +text{*Collapse applications of @{term complex_of_real} to @{term number_of}*}
    4.41 +lemma complex_number_of [simp]: "complex_of_real (number_of w) = number_of w"
    4.42 +apply (induct w) 
    4.43 +apply (simp_all only: number_of complex_of_real_add [symmetric] 
    4.44 +                      complex_of_real_minus, simp_all) 
    4.45 +done
    4.46 +
    4.47 +text{*This theorem is necessary because theorems such as
    4.48 +   @{text iszero_number_of_0} only hold for ordered rings. They cannot
    4.49 +   be generalized to fields in general because they fail for finite fields.
    4.50 +   They work for type complex because the reals can be embedded in them.*}
    4.51 +lemma iszero_complex_number_of [simp]:
    4.52 +     "iszero (number_of w :: complex) = iszero (number_of w :: real)"
    4.53 +by (simp only: complex_of_real_zero_iff complex_number_of [symmetric] 
    4.54 +               iszero_def)  
    4.55 +
    4.56 +
    4.57 +(*These allow simplification of expressions involving mixed numbers.
    4.58 +  Convert???
    4.59 +Goalw [complex_number_of_def] 
    4.60 +  "((number_of xa :: complex) + ii * number_of ya =  
    4.61 +        number_of xb) =  
    4.62 +   (((number_of xa :: complex) = number_of xb) &  
    4.63 +    ((number_of ya :: complex) = 0))"
    4.64 +by (auto_tac (claset(), HOL_ss addsimps [complex_eq_cancel_iff2,
    4.65 +    complex_of_real_zero_iff]));
    4.66 +qed "complex_number_of_eq_cancel_iff2";
    4.67 +Addsimps [complex_number_of_eq_cancel_iff2];
    4.68 +
    4.69 +Goalw [complex_number_of_def] 
    4.70 +  "((number_of xa :: complex) + number_of ya * ii = \
    4.71 +\       number_of xb) = \
    4.72 +\  (((number_of xa :: complex) = number_of xb) & \
    4.73 +\   ((number_of ya :: complex) = 0))";
    4.74 +by (auto_tac (claset(), HOL_ss addsimps [complex_eq_cancel_iff2a,
    4.75 +    complex_of_real_zero_iff]));
    4.76 +qed "complex_number_of_eq_cancel_iff2a";
    4.77 +Addsimps [complex_number_of_eq_cancel_iff2a];
    4.78 +
    4.79 +Goalw [complex_number_of_def] 
    4.80 +  "((number_of xa :: complex) + ii * number_of ya = \
    4.81 +\    ii * number_of yb) = \
    4.82 +\  (((number_of xa :: complex) = 0) & \
    4.83 +\   ((number_of ya :: complex) = number_of yb))";
    4.84 +by (auto_tac (claset(), HOL_ss addsimps [complex_eq_cancel_iff3,
    4.85 +    complex_of_real_zero_iff]));
    4.86 +qed "complex_number_of_eq_cancel_iff3";
    4.87 +Addsimps [complex_number_of_eq_cancel_iff3];
    4.88 +
    4.89 +Goalw [complex_number_of_def] 
    4.90 +  "((number_of xa :: complex) + number_of ya * ii= \
    4.91 +\    ii * number_of yb) = \
    4.92 +\  (((number_of xa :: complex) = 0) & \
    4.93 +\   ((number_of ya :: complex) = number_of yb))";
    4.94 +by (auto_tac (claset(), HOL_ss addsimps [complex_eq_cancel_iff3a,
    4.95 +    complex_of_real_zero_iff]));
    4.96 +qed "complex_number_of_eq_cancel_iff3a";
    4.97 +Addsimps [complex_number_of_eq_cancel_iff3a];
    4.98 +*)
    4.99 +
   4.100 +lemma complex_number_of_cnj [simp]: "cnj(number_of v :: complex) = number_of v"
   4.101 +apply (subst complex_number_of [symmetric])
   4.102 +apply (rule complex_cnj_complex_of_real)
   4.103 +done
   4.104 +
   4.105 +lemma complex_number_of_cmod: 
   4.106 +      "cmod(number_of v :: complex) = abs (number_of v :: real)"
   4.107 +by (simp only: complex_number_of [symmetric] complex_mod_complex_of_real)
   4.108 +
   4.109 +lemma complex_number_of_Re [simp]: "Re(number_of v :: complex) = number_of v"
   4.110 +by (simp only: complex_number_of [symmetric] Re_complex_of_real)
   4.111 +
   4.112 +lemma complex_number_of_Im [simp]: "Im(number_of v :: complex) = 0"
   4.113 +by (simp only: complex_number_of [symmetric] Im_complex_of_real)
   4.114 +
   4.115 +lemma expi_two_pi_i [simp]: "expi((2::complex) * complex_of_real pi * ii) = 1"
   4.116 +by (simp add: expi_def complex_Re_mult_eq complex_Im_mult_eq cis_def)
   4.117 +
   4.118 +
   4.119 +(*examples:
   4.120 +print_depth 22
   4.121 +set timing;
   4.122 +set trace_simp;
   4.123 +fun test s = (Goal s, by (Simp_tac 1)); 
   4.124 +
   4.125 +test "23 * ii + 45 * ii= (x::complex)";
   4.126 +
   4.127 +test "5 * ii + 12 - 45 * ii= (x::complex)";
   4.128 +test "5 * ii + 40 - 12 * ii + 9 = (x::complex) + 89 * ii";
   4.129 +test "5 * ii + 40 - 12 * ii + 9 - 78 = (x::complex) + 89 * ii";
   4.130 +
   4.131 +test "l + 10 * ii + 90 + 3*l +  9 + 45 * ii= (x::complex)";
   4.132 +test "87 + 10 * ii + 90 + 3*7 +  9 + 45 * ii= (x::complex)";
   4.133 +
   4.134 +
   4.135 +fun test s = (Goal s; by (Asm_simp_tac 1)); 
   4.136 +
   4.137 +test "x*k = k*(y::complex)";
   4.138 +test "k = k*(y::complex)"; 
   4.139 +test "a*(b*c) = (b::complex)";
   4.140 +test "a*(b*c) = d*(b::complex)*(x*a)";
   4.141 +
   4.142 +
   4.143 +test "(x*k) / (k*(y::complex)) = (uu::complex)";
   4.144 +test "(k) / (k*(y::complex)) = (uu::complex)"; 
   4.145 +test "(a*(b*c)) / ((b::complex)) = (uu::complex)";
   4.146 +test "(a*(b*c)) / (d*(b::complex)*(x*a)) = (uu::complex)";
   4.147 +
   4.148 +(*FIXME: what do we do about this?*)
   4.149 +test "a*(b*c)/(y*z) = d*(b::complex)*(x*a)/z";
   4.150 +*)
   4.151 +
   4.152  
   4.153  ML
   4.154  {*
     5.1 --- a/src/HOL/Complex/ComplexArith0.ML	Sat Feb 14 02:06:12 2004 +0100
     5.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.3 @@ -1,187 +0,0 @@
     5.4 -(*  Title:       ComplexArith0.ML
     5.5 -    Author:      Jacques D. Fleuriot
     5.6 -    Copyright:   2001  University of Edinburgh
     5.7 -    Description: Assorted facts that need binary literals 
     5.8 -		 Also, common factor cancellation (see e.g. HyperArith0)
     5.9 -*)
    5.10 -
    5.11 -local
    5.12 -  open Complex_Numeral_Simprocs
    5.13 -in
    5.14 -
    5.15 -val rel_complex_number_of = [eq_complex_number_of];
    5.16 -
    5.17 -
    5.18 -structure CancelNumeralFactorCommon =
    5.19 -  struct
    5.20 -  val mk_coeff		= mk_coeff
    5.21 -  val dest_coeff	= dest_coeff 1
    5.22 -  val trans_tac         = Real_Numeral_Simprocs.trans_tac
    5.23 -  val norm_tac =  ALLGOALS (simp_tac (HOL_ss addsimps complex_minus_from_mult_simps @ mult_1s)) 
    5.24 -                  THEN ALLGOALS (simp_tac (HOL_ss addsimps bin_simps@complex_mult_minus_simps))
    5.25 -                  THEN ALLGOALS (simp_tac (HOL_ss addsimps mult_ac))
    5.26 -  val numeral_simp_tac	=  ALLGOALS (simp_tac (HOL_ss addsimps rel_complex_number_of@bin_simps))
    5.27 -  val simplify_meta_eq  = simplify_meta_eq
    5.28 -  end
    5.29 -
    5.30 -
    5.31 -structure DivCancelNumeralFactor = CancelNumeralFactorFun
    5.32 - (open CancelNumeralFactorCommon
    5.33 -  val prove_conv = Bin_Simprocs.prove_conv
    5.34 -  val mk_bal   = HOLogic.mk_binop "HOL.divide"
    5.35 -  val dest_bal = HOLogic.dest_bin "HOL.divide" complexT
    5.36 -  val cancel = mult_divide_cancel_left RS trans
    5.37 -  val neg_exchanges = false
    5.38 -)
    5.39 -
    5.40 -
    5.41 -structure EqCancelNumeralFactor = CancelNumeralFactorFun
    5.42 - (open CancelNumeralFactorCommon
    5.43 -  val prove_conv = Bin_Simprocs.prove_conv
    5.44 -  val mk_bal   = HOLogic.mk_eq
    5.45 -  val dest_bal = HOLogic.dest_bin "op =" complexT
    5.46 -  val cancel = field_mult_cancel_left RS trans
    5.47 -  val neg_exchanges = false
    5.48 -)
    5.49 -
    5.50 -val complex_cancel_numeral_factors_relations = 
    5.51 -  map prep_simproc
    5.52 -   [("complexeq_cancel_numeral_factor",
    5.53 -     ["(l::complex) * m = n", "(l::complex) = m * n"], 
    5.54 -     EqCancelNumeralFactor.proc)];
    5.55 -
    5.56 -val complex_cancel_numeral_factors_divide = prep_simproc
    5.57 -	("complexdiv_cancel_numeral_factor", 
    5.58 -	 ["((l::complex) * m) / n", "(l::complex) / (m * n)", 
    5.59 -                     "((number_of v)::complex) / (number_of w)"], 
    5.60 -	 DivCancelNumeralFactor.proc);
    5.61 -
    5.62 -val complex_cancel_numeral_factors = 
    5.63 -    complex_cancel_numeral_factors_relations @ 
    5.64 -    [complex_cancel_numeral_factors_divide];
    5.65 -
    5.66 -end;
    5.67 -
    5.68 -
    5.69 -Addsimprocs complex_cancel_numeral_factors;
    5.70 -
    5.71 -
    5.72 -(*examples:
    5.73 -print_depth 22;
    5.74 -set timing;
    5.75 -set trace_simp;
    5.76 -fun test s = (Goal s; by (Simp_tac 1)); 
    5.77 -
    5.78 -
    5.79 -test "9*x = 12 * (y::complex)";
    5.80 -test "(9*x) / (12 * (y::complex)) = z";
    5.81 -
    5.82 -test "-99*x = 132 * (y::complex)";
    5.83 -
    5.84 -test "999*x = -396 * (y::complex)";
    5.85 -test "(999*x) / (-396 * (y::complex)) = z";
    5.86 -
    5.87 -test "-99*x = -81 * (y::complex)";
    5.88 -test "(-99*x) / (-81 * (y::complex)) = z";
    5.89 -
    5.90 -test "-2 * x = -1 * (y::complex)";
    5.91 -test "-2 * x = -(y::complex)";
    5.92 -test "(-2 * x) / (-1 * (y::complex)) = z";
    5.93 -
    5.94 -*)
    5.95 -
    5.96 -
    5.97 -(** Declarations for ExtractCommonTerm **)
    5.98 -
    5.99 -local
   5.100 -  open Complex_Numeral_Simprocs
   5.101 -in
   5.102 -
   5.103 -structure CancelFactorCommon =
   5.104 -  struct
   5.105 -  val mk_sum    	= long_mk_prod
   5.106 -  val dest_sum		= dest_prod
   5.107 -  val mk_coeff		= mk_coeff
   5.108 -  val dest_coeff	= dest_coeff
   5.109 -  val find_first	= find_first []
   5.110 -  val trans_tac         = Real_Numeral_Simprocs.trans_tac
   5.111 -  val norm_tac = ALLGOALS (simp_tac (HOL_ss addsimps mult_1s@mult_ac))
   5.112 -  end;
   5.113 -
   5.114 -
   5.115 -structure EqCancelFactor = ExtractCommonTermFun
   5.116 - (open CancelFactorCommon
   5.117 -  val prove_conv = Bin_Simprocs.prove_conv
   5.118 -  val mk_bal   = HOLogic.mk_eq
   5.119 -  val dest_bal = HOLogic.dest_bin "op =" complexT
   5.120 -  val simplify_meta_eq  = cancel_simplify_meta_eq field_mult_cancel_left
   5.121 -);
   5.122 -
   5.123 -
   5.124 -structure DivideCancelFactor = ExtractCommonTermFun
   5.125 - (open CancelFactorCommon
   5.126 -  val prove_conv = Bin_Simprocs.prove_conv
   5.127 -  val mk_bal   = HOLogic.mk_binop "HOL.divide"
   5.128 -  val dest_bal = HOLogic.dest_bin "HOL.divide" complexT
   5.129 -  val simplify_meta_eq  = cancel_simplify_meta_eq mult_divide_cancel_eq_if
   5.130 -);
   5.131 -
   5.132 -val complex_cancel_factor = 
   5.133 -  map prep_simproc
   5.134 -   [("complex_eq_cancel_factor", ["(l::complex) * m = n", "(l::complex) = m * n"], 
   5.135 -     EqCancelFactor.proc),
   5.136 -    ("complex_divide_cancel_factor", ["((l::complex) * m) / n", "(l::complex) / (m * n)"], 
   5.137 -     DivideCancelFactor.proc)];
   5.138 -
   5.139 -end;
   5.140 -
   5.141 -Addsimprocs complex_cancel_factor;
   5.142 -
   5.143 -
   5.144 -(*examples:
   5.145 -print_depth 22;
   5.146 -set timing;
   5.147 -set trace_simp;
   5.148 -fun test s = (Goal s; by (Asm_simp_tac 1)); 
   5.149 -
   5.150 -test "x*k = k*(y::complex)";
   5.151 -test "k = k*(y::complex)"; 
   5.152 -test "a*(b*c) = (b::complex)";
   5.153 -test "a*(b*c) = d*(b::complex)*(x*a)";
   5.154 -
   5.155 -
   5.156 -test "(x*k) / (k*(y::complex)) = (uu::complex)";
   5.157 -test "(k) / (k*(y::complex)) = (uu::complex)"; 
   5.158 -test "(a*(b*c)) / ((b::complex)) = (uu::complex)";
   5.159 -test "(a*(b*c)) / (d*(b::complex)*(x*a)) = (uu::complex)";
   5.160 -
   5.161 -(*FIXME: what do we do about this?*)
   5.162 -test "a*(b*c)/(y*z) = d*(b::complex)*(x*a)/z";
   5.163 -*)
   5.164 -
   5.165 -
   5.166 -(** Division by 1, -1 **)
   5.167 -
   5.168 -Goal "x/-1 = -(x::complex)";
   5.169 -by (Simp_tac 1); 
   5.170 -qed "complex_divide_minus1";
   5.171 -Addsimps [complex_divide_minus1];
   5.172 -
   5.173 -Goal "-1/(x::complex) = - (1/x)";
   5.174 -by (simp_tac (simpset() addsimps [complex_divide_def, inverse_minus_eq]) 1); 
   5.175 -qed "complex_minus1_divide";
   5.176 -Addsimps [complex_minus1_divide];
   5.177 -
   5.178 -Goal "(x + - a = (0::complex)) = (x=a)";
   5.179 -by (simp_tac (simpset() addsimps [diff_eq_eq,symmetric complex_diff_def]) 1);
   5.180 -qed "complex_add_minus_iff";
   5.181 -Addsimps [complex_add_minus_iff];
   5.182 -
   5.183 -Goal "(x+y = (0::complex)) = (y = -x)";
   5.184 -by Auto_tac;
   5.185 -by (dtac (sym RS (diff_eq_eq RS iffD2)) 1);
   5.186 -by Auto_tac;  
   5.187 -qed "complex_add_eq_0_iff";
   5.188 -AddIffs [complex_add_eq_0_iff];
   5.189 -
   5.190 -
     6.1 --- a/src/HOL/Complex/ComplexArith0.thy	Sat Feb 14 02:06:12 2004 +0100
     6.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.3 @@ -1,2 +0,0 @@
     6.4 -ComplexArith0 = ComplexBin
     6.5 -
     7.1 --- a/src/HOL/Complex/ComplexBin.ML	Sat Feb 14 02:06:12 2004 +0100
     7.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.3 @@ -1,538 +0,0 @@
     7.4 -(*  Title:      ComplexBin.ML
     7.5 -    Author:     Jacques D. Fleuriot
     7.6 -    Copyright:  2001 University of Edinburgh
     7.7 -    Descrition: Binary arithmetic for the complex numbers
     7.8 -*)
     7.9 -
    7.10 -(** complex_of_real (coercion from real to complex) **)
    7.11 -
    7.12 -Goal "complex_of_real (number_of w) = number_of w";
    7.13 -by (simp_tac (simpset() addsimps [complex_number_of_def]) 1);
    7.14 -qed "complex_number_of";
    7.15 -Addsimps [complex_number_of];
    7.16 - 
    7.17 -Goalw [complex_number_of_def] "Numeral0 = (0::complex)";
    7.18 -by (Simp_tac 1);
    7.19 -qed "complex_numeral_0_eq_0";
    7.20 - 
    7.21 -Goalw [complex_number_of_def] "Numeral1 = (1::complex)";
    7.22 -by (Simp_tac 1);
    7.23 -qed "complex_numeral_1_eq_1";
    7.24 -
    7.25 -(** Addition **)
    7.26 -
    7.27 -Goal "(number_of v :: complex) + number_of v' = number_of (bin_add v v')";
    7.28 -by (simp_tac
    7.29 -    (HOL_ss addsimps [complex_number_of_def, 
    7.30 -                      complex_of_real_add, add_real_number_of]) 1);
    7.31 -qed "add_complex_number_of";
    7.32 -Addsimps [add_complex_number_of];
    7.33 -
    7.34 -
    7.35 -(** Subtraction **)
    7.36 -
    7.37 -Goalw [complex_number_of_def]
    7.38 -     "- (number_of w :: complex) = number_of (bin_minus w)";
    7.39 -by (simp_tac
    7.40 -    (HOL_ss addsimps [minus_real_number_of, complex_of_real_minus RS sym]) 1);
    7.41 -qed "minus_complex_number_of";
    7.42 -Addsimps [minus_complex_number_of];
    7.43 -
    7.44 -Goalw [complex_number_of_def, complex_diff_def]
    7.45 -     "(number_of v :: complex) - number_of w = number_of (bin_add v (bin_minus w))";
    7.46 -by (Simp_tac 1); 
    7.47 -qed "diff_complex_number_of";
    7.48 -Addsimps [diff_complex_number_of];
    7.49 -
    7.50 -
    7.51 -(** Multiplication **)
    7.52 -
    7.53 -Goal "(number_of v :: complex) * number_of v' = number_of (bin_mult v v')";
    7.54 -by (simp_tac
    7.55 -    (HOL_ss addsimps [complex_number_of_def, 
    7.56 -	              complex_of_real_mult, mult_real_number_of]) 1);
    7.57 -qed "mult_complex_number_of";
    7.58 -Addsimps [mult_complex_number_of];
    7.59 -
    7.60 -Goal "(2::complex) = 1 + 1";
    7.61 -by (simp_tac (simpset() addsimps [complex_numeral_1_eq_1 RS sym]) 1);
    7.62 -val lemma = result();
    7.63 -
    7.64 -(*For specialist use: NOT as default simprules*)
    7.65 -Goal "2 * z = (z+z::complex)";
    7.66 -by (simp_tac (simpset () addsimps [lemma, left_distrib]) 1);
    7.67 -qed "complex_mult_2";
    7.68 -
    7.69 -Goal "z * 2 = (z+z::complex)";
    7.70 -by (stac mult_commute 1 THEN rtac complex_mult_2 1);
    7.71 -qed "complex_mult_2_right";
    7.72 -
    7.73 -(** Equals (=) **)
    7.74 -
    7.75 -Goal "((number_of v :: complex) = number_of v') = \
    7.76 -\     iszero (number_of (bin_add v (bin_minus v')) :: int)";
    7.77 -by (simp_tac
    7.78 -    (HOL_ss addsimps [complex_number_of_def, 
    7.79 -	              complex_of_real_eq_iff, eq_real_number_of]) 1);
    7.80 -qed "eq_complex_number_of";
    7.81 -Addsimps [eq_complex_number_of];
    7.82 -
    7.83 -(*** New versions of existing theorems involving 0, 1 ***)
    7.84 -
    7.85 -Goal "- 1 = (-1::complex)";
    7.86 -by (simp_tac (simpset() addsimps [complex_numeral_1_eq_1 RS sym]) 1);
    7.87 -qed "complex_minus_1_eq_m1";
    7.88 -
    7.89 -Goal "-1 * z = -(z::complex)";
    7.90 -by (simp_tac (simpset() addsimps [complex_minus_1_eq_m1 RS sym]) 1);
    7.91 -qed "complex_mult_minus1";
    7.92 -
    7.93 -Goal "z * -1 = -(z::complex)";
    7.94 -by (stac mult_commute 1 THEN rtac complex_mult_minus1 1);
    7.95 -qed "complex_mult_minus1_right";
    7.96 -
    7.97 -Addsimps [complex_mult_minus1,complex_mult_minus1_right];
    7.98 -
    7.99 -
   7.100 -(*Maps 0 to Numeral0 and 1 to Numeral1 and -Numeral1 to -1*)
   7.101 -val complex_numeral_ss = 
   7.102 -    hypreal_numeral_ss addsimps [complex_numeral_0_eq_0 RS sym, complex_numeral_1_eq_1 RS sym, 
   7.103 -		                 complex_minus_1_eq_m1];
   7.104 -
   7.105 -fun rename_numerals th = 
   7.106 -    asm_full_simplify complex_numeral_ss (Thm.transfer (the_context ()) th);
   7.107 -
   7.108 -(*Now insert some identities previously stated for 0 and 1c*)
   7.109 -
   7.110 -Addsimps [complex_numeral_0_eq_0,complex_numeral_1_eq_1];
   7.111 -
   7.112 -Goal "number_of v + (number_of w + z) = (number_of(bin_add v w) + z::complex)";
   7.113 -by (auto_tac (claset(),simpset() addsimps [complex_add_assoc RS sym]));
   7.114 -qed "complex_add_number_of_left";
   7.115 -
   7.116 -Goal "number_of v *(number_of w * z) = (number_of(bin_mult v w) * z::complex)";
   7.117 -by (simp_tac (simpset() addsimps [mult_assoc RS sym]) 1);
   7.118 -qed "complex_mult_number_of_left";
   7.119 -
   7.120 -Goalw [complex_diff_def]
   7.121 -    "number_of v + (number_of w - c) = number_of(bin_add v w) - (c::complex)";
   7.122 -by (rtac complex_add_number_of_left 1);
   7.123 -qed "complex_add_number_of_diff1";
   7.124 -
   7.125 -Goal "number_of v + (c - number_of w) = \
   7.126 -\     number_of (bin_add v (bin_minus w)) + (c::complex)";
   7.127 -by (auto_tac (claset(),simpset() addsimps [complex_diff_def]@ add_ac));
   7.128 -qed "complex_add_number_of_diff2";
   7.129 -
   7.130 -Addsimps [complex_add_number_of_left, complex_mult_number_of_left,
   7.131 -	  complex_add_number_of_diff1, complex_add_number_of_diff2]; 
   7.132 -
   7.133 -
   7.134 -(**** Simprocs for numeric literals ****)
   7.135 -
   7.136 -(** Combining of literal coefficients in sums of products **)
   7.137 -
   7.138 -Goal "(x = y) = (x-y = (0::complex))";
   7.139 -by (simp_tac (simpset() addsimps [diff_eq_eq]) 1);   
   7.140 -qed "complex_eq_iff_diff_eq_0";
   7.141 -
   7.142 -
   7.143 -
   7.144 -structure Complex_Numeral_Simprocs =
   7.145 -struct
   7.146 -
   7.147 -(*Maps 0 to Numeral0 and 1 to Numeral1 so that arithmetic in simprocs
   7.148 -  isn't complicated by the abstract 0 and 1.*)
   7.149 -val numeral_syms = [complex_numeral_0_eq_0 RS sym, complex_numeral_1_eq_1 RS sym];
   7.150 -
   7.151 -
   7.152 -(*Utilities*)
   7.153 -
   7.154 -val complexT = Type("Complex.complex",[]);
   7.155 -
   7.156 -fun mk_numeral n = HOLogic.number_of_const complexT $ HOLogic.mk_bin n;
   7.157 -
   7.158 -val dest_numeral = Real_Numeral_Simprocs.dest_numeral;
   7.159 -val find_first_numeral = Real_Numeral_Simprocs.find_first_numeral;
   7.160 -
   7.161 -val zero = mk_numeral 0;
   7.162 -val mk_plus = HOLogic.mk_binop "op +";
   7.163 -
   7.164 -val uminus_const = Const ("uminus", complexT --> complexT);
   7.165 -
   7.166 -(*Thus mk_sum[t] yields t+0; longer sums don't have a trailing zero*)
   7.167 -fun mk_sum []        = zero
   7.168 -  | mk_sum [t,u]     = mk_plus (t, u)
   7.169 -  | mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
   7.170 -
   7.171 -(*this version ALWAYS includes a trailing zero*)
   7.172 -fun long_mk_sum []        = zero
   7.173 -  | long_mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
   7.174 -
   7.175 -val dest_plus = HOLogic.dest_bin "op +" complexT;
   7.176 -
   7.177 -(*decompose additions AND subtractions as a sum*)
   7.178 -fun dest_summing (pos, Const ("op +", _) $ t $ u, ts) =
   7.179 -        dest_summing (pos, t, dest_summing (pos, u, ts))
   7.180 -  | dest_summing (pos, Const ("op -", _) $ t $ u, ts) =
   7.181 -        dest_summing (pos, t, dest_summing (not pos, u, ts))
   7.182 -  | dest_summing (pos, t, ts) =
   7.183 -	if pos then t::ts else uminus_const$t :: ts;
   7.184 -
   7.185 -fun dest_sum t = dest_summing (true, t, []);
   7.186 -
   7.187 -val mk_diff = HOLogic.mk_binop "op -";
   7.188 -val dest_diff = HOLogic.dest_bin "op -" complexT;
   7.189 -
   7.190 -val one = mk_numeral 1;
   7.191 -val mk_times = HOLogic.mk_binop "op *";
   7.192 -
   7.193 -fun mk_prod [] = one
   7.194 -  | mk_prod [t] = t
   7.195 -  | mk_prod (t :: ts) = if t = one then mk_prod ts
   7.196 -                        else mk_times (t, mk_prod ts);
   7.197 -
   7.198 -val dest_times = HOLogic.dest_bin "op *" complexT;
   7.199 -
   7.200 -fun dest_prod t =
   7.201 -      let val (t,u) = dest_times t 
   7.202 -      in  dest_prod t @ dest_prod u  end
   7.203 -      handle TERM _ => [t];
   7.204 -
   7.205 -(*DON'T do the obvious simplifications; that would create special cases*) 
   7.206 -fun mk_coeff (k, ts) = mk_times (mk_numeral k, ts);
   7.207 -
   7.208 -(*Express t as a product of (possibly) a numeral with other sorted terms*)
   7.209 -fun dest_coeff sign (Const ("uminus", _) $ t) = dest_coeff (~sign) t
   7.210 -  | dest_coeff sign t =
   7.211 -    let val ts = sort Term.term_ord (dest_prod t)
   7.212 -	val (n, ts') = find_first_numeral [] ts
   7.213 -                          handle TERM _ => (1, ts)
   7.214 -    in (sign*n, mk_prod ts') end;
   7.215 -
   7.216 -(*Find first coefficient-term THAT MATCHES u*)
   7.217 -fun find_first_coeff past u [] = raise TERM("find_first_coeff", []) 
   7.218 -  | find_first_coeff past u (t::terms) =
   7.219 -	let val (n,u') = dest_coeff 1 t
   7.220 -	in  if u aconv u' then (n, rev past @ terms)
   7.221 -			  else find_first_coeff (t::past) u terms
   7.222 -	end
   7.223 -	handle TERM _ => find_first_coeff (t::past) u terms;
   7.224 -
   7.225 -
   7.226 -(*Simplify Numeral0+n, n+Numeral0, Numeral1*n, n*Numeral1*)
   7.227 -val add_0s = map rename_numerals [complex_add_zero_left, complex_add_zero_right];
   7.228 -val mult_plus_1s = map rename_numerals [complex_mult_one_left, complex_mult_one_right];
   7.229 -val mult_minus_1s = map rename_numerals
   7.230 -                      [complex_mult_minus1, complex_mult_minus1_right];
   7.231 -val mult_1s = mult_plus_1s @ mult_minus_1s;
   7.232 -
   7.233 -(*To perform binary arithmetic*)
   7.234 -val bin_simps =
   7.235 -    [complex_numeral_0_eq_0 RS sym, complex_numeral_1_eq_1 RS sym,
   7.236 -     add_complex_number_of, complex_add_number_of_left, 
   7.237 -     minus_complex_number_of, diff_complex_number_of, mult_complex_number_of, 
   7.238 -     complex_mult_number_of_left] @ bin_arith_simps @ bin_rel_simps;
   7.239 -
   7.240 -(*Binary arithmetic BUT NOT ADDITION since it may collapse adjacent terms
   7.241 -  during re-arrangement*)
   7.242 -val non_add_bin_simps = 
   7.243 -    bin_simps \\ [complex_add_number_of_left, add_complex_number_of];
   7.244 -
   7.245 -(*To evaluate binary negations of coefficients*)
   7.246 -val complex_minus_simps = NCons_simps @
   7.247 -                   [complex_minus_1_eq_m1,minus_complex_number_of, 
   7.248 -		    bin_minus_1, bin_minus_0, bin_minus_Pls, bin_minus_Min,
   7.249 -		    bin_pred_1, bin_pred_0, bin_pred_Pls, bin_pred_Min];
   7.250 -
   7.251 -(*To let us treat subtraction as addition*)
   7.252 -val diff_simps = [complex_diff_def, minus_add_distrib, minus_minus];
   7.253 -
   7.254 -(* push the unary minus down: - x * y = x * - y *)
   7.255 -val complex_minus_mult_eq_1_to_2 = 
   7.256 -    [minus_mult_left RS sym, minus_mult_right] MRS trans 
   7.257 -    |> standard;
   7.258 -
   7.259 -(*to extract again any uncancelled minuses*)
   7.260 -val complex_minus_from_mult_simps = 
   7.261 -    [minus_minus, minus_mult_left RS sym, minus_mult_right RS sym];
   7.262 -
   7.263 -(*combine unary minus with numeric literals, however nested within a product*)
   7.264 -val complex_mult_minus_simps =
   7.265 -    [mult_assoc, minus_mult_left, complex_minus_mult_eq_1_to_2];
   7.266 -
   7.267 -(*Final simplification: cancel + and *  *)
   7.268 -val simplify_meta_eq = 
   7.269 -    Int_Numeral_Simprocs.simplify_meta_eq
   7.270 -         [add_zero_left, add_zero_right,
   7.271 - 	  mult_zero_left, mult_zero_right, mult_1, mult_1_right];
   7.272 -
   7.273 -val prep_simproc = Real_Numeral_Simprocs.prep_simproc;
   7.274 -
   7.275 -
   7.276 -structure CancelNumeralsCommon =
   7.277 -  struct
   7.278 -  val mk_sum    	= mk_sum
   7.279 -  val dest_sum		= dest_sum
   7.280 -  val mk_coeff		= mk_coeff
   7.281 -  val dest_coeff	= dest_coeff 1
   7.282 -  val find_first_coeff	= find_first_coeff []
   7.283 -  val trans_tac         = Real_Numeral_Simprocs.trans_tac
   7.284 -  val norm_tac = 
   7.285 -     ALLGOALS (simp_tac (HOL_ss addsimps add_0s@mult_1s@diff_simps@
   7.286 -                                         complex_minus_simps@add_ac))
   7.287 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps non_add_bin_simps@complex_mult_minus_simps))
   7.288 -     THEN ALLGOALS
   7.289 -              (simp_tac (HOL_ss addsimps complex_minus_from_mult_simps@
   7.290 -                                         add_ac@mult_ac))
   7.291 -  val numeral_simp_tac	= ALLGOALS (simp_tac (HOL_ss addsimps add_0s@bin_simps))
   7.292 -  val simplify_meta_eq  = simplify_meta_eq
   7.293 -  end;
   7.294 -
   7.295 -
   7.296 -structure EqCancelNumerals = CancelNumeralsFun
   7.297 - (open CancelNumeralsCommon
   7.298 -  val prove_conv = Bin_Simprocs.prove_conv
   7.299 -  val mk_bal   = HOLogic.mk_eq
   7.300 -  val dest_bal = HOLogic.dest_bin "op =" complexT
   7.301 -  val bal_add1 = eq_add_iff1 RS trans
   7.302 -  val bal_add2 = eq_add_iff2 RS trans
   7.303 -);
   7.304 -
   7.305 -
   7.306 -val cancel_numerals = 
   7.307 -  map prep_simproc
   7.308 -   [("complexeq_cancel_numerals",
   7.309 -               ["(l::complex) + m = n", "(l::complex) = m + n", 
   7.310 -		"(l::complex) - m = n", "(l::complex) = m - n", 
   7.311 -		"(l::complex) * m = n", "(l::complex) = m * n"], 
   7.312 -     EqCancelNumerals.proc)];
   7.313 -
   7.314 -structure CombineNumeralsData =
   7.315 -  struct
   7.316 -  val add		= op + : int*int -> int 
   7.317 -  val mk_sum    	= long_mk_sum    (*to work for e.g. #2*x + #3*x *)
   7.318 -  val dest_sum		= dest_sum
   7.319 -  val mk_coeff		= mk_coeff
   7.320 -  val dest_coeff	= dest_coeff 1
   7.321 -  val left_distrib	= combine_common_factor RS trans
   7.322 -  val prove_conv	= Bin_Simprocs.prove_conv_nohyps
   7.323 -  val trans_tac         = Real_Numeral_Simprocs.trans_tac
   7.324 -  val norm_tac = 
   7.325 -     ALLGOALS (simp_tac (HOL_ss addsimps add_0s@mult_1s@diff_simps@
   7.326 -                                         complex_minus_simps@add_ac))
   7.327 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps non_add_bin_simps@complex_mult_minus_simps))
   7.328 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps complex_minus_from_mult_simps@
   7.329 -                                              add_ac@mult_ac))
   7.330 -  val numeral_simp_tac	= ALLGOALS 
   7.331 -                    (simp_tac (HOL_ss addsimps add_0s@bin_simps))
   7.332 -  val simplify_meta_eq  = simplify_meta_eq
   7.333 -  end;
   7.334 -
   7.335 -structure CombineNumerals = CombineNumeralsFun(CombineNumeralsData);
   7.336 -
   7.337 -val combine_numerals = 
   7.338 -    prep_simproc ("complex_combine_numerals",
   7.339 -		  ["(i::complex) + j", "(i::complex) - j"],
   7.340 -		  CombineNumerals.proc);
   7.341 -
   7.342 -
   7.343 -(** Declarations for ExtractCommonTerm **)
   7.344 -
   7.345 -(*this version ALWAYS includes a trailing one*)
   7.346 -fun long_mk_prod []        = one
   7.347 -  | long_mk_prod (t :: ts) = mk_times (t, mk_prod ts);
   7.348 -
   7.349 -(*Find first term that matches u*)
   7.350 -fun find_first past u []         = raise TERM("find_first", []) 
   7.351 -  | find_first past u (t::terms) =
   7.352 -	if u aconv t then (rev past @ terms)
   7.353 -        else find_first (t::past) u terms
   7.354 -	handle TERM _ => find_first (t::past) u terms;
   7.355 -
   7.356 -(*Final simplification: cancel + and *  *)
   7.357 -fun cancel_simplify_meta_eq cancel_th th = 
   7.358 -    Int_Numeral_Simprocs.simplify_meta_eq 
   7.359 -        [complex_mult_one_left, complex_mult_one_right] 
   7.360 -        (([th, cancel_th]) MRS trans);
   7.361 -
   7.362 -(*** Making constant folding work for 0 and 1 too ***)
   7.363 -
   7.364 -structure ComplexAbstractNumeralsData =
   7.365 -  struct
   7.366 -  val dest_eq         = HOLogic.dest_eq o HOLogic.dest_Trueprop o concl_of
   7.367 -  val is_numeral      = Bin_Simprocs.is_numeral
   7.368 -  val numeral_0_eq_0  = complex_numeral_0_eq_0
   7.369 -  val numeral_1_eq_1  = complex_numeral_1_eq_1
   7.370 -  val prove_conv      = Bin_Simprocs.prove_conv_nohyps_novars
   7.371 -  fun norm_tac simps  = ALLGOALS (simp_tac (HOL_ss addsimps simps))
   7.372 -  val simplify_meta_eq = Bin_Simprocs.simplify_meta_eq
   7.373 -  end;
   7.374 -
   7.375 -structure ComplexAbstractNumerals = AbstractNumeralsFun (ComplexAbstractNumeralsData);
   7.376 -
   7.377 -(*For addition, we already have rules for the operand 0.
   7.378 -  Multiplication is omitted because there are already special rules for
   7.379 -  both 0 and 1 as operands.  Unary minus is trivial, just have - 1 = -1.
   7.380 -  For the others, having three patterns is a compromise between just having
   7.381 -  one (many spurious calls) and having nine (just too many!) *)
   7.382 -val eval_numerals =
   7.383 -  map prep_simproc
   7.384 -   [("complex_add_eval_numerals",
   7.385 -     ["(m::complex) + 1", "(m::complex) + number_of v"],
   7.386 -     ComplexAbstractNumerals.proc add_complex_number_of),
   7.387 -    ("complex_diff_eval_numerals",
   7.388 -     ["(m::complex) - 1", "(m::complex) - number_of v"],
   7.389 -     ComplexAbstractNumerals.proc diff_complex_number_of),
   7.390 -    ("complex_eq_eval_numerals",
   7.391 -     ["(m::complex) = 0", "(m::complex) = 1", "(m::complex) = number_of v"],
   7.392 -     ComplexAbstractNumerals.proc eq_complex_number_of)];
   7.393 -
   7.394 -end;
   7.395 -
   7.396 -Addsimprocs Complex_Numeral_Simprocs.eval_numerals;
   7.397 -Addsimprocs Complex_Numeral_Simprocs.cancel_numerals;
   7.398 -Addsimprocs [Complex_Numeral_Simprocs.combine_numerals];
   7.399 -
   7.400 -(*examples:
   7.401 -print_depth 22;
   7.402 -set timing;
   7.403 -set trace_simp;
   7.404 -fun test s = (Goal s, by (Simp_tac 1)); 
   7.405 -
   7.406 -test "l +  2 +  2 +  2 + (l +  2) + (oo +  2) = (uu::complex)";
   7.407 -test " 2*u = (u::complex)";
   7.408 -test "(i + j +  12 + (k::complex)) -  15 = y";
   7.409 -test "(i + j +  12 + (k::complex)) -  5 = y";
   7.410 -
   7.411 -test "( 2*x - (u*v) + y) - v* 3*u = (w::complex)";
   7.412 -test "( 2*x*u*v + (u*v)* 4 + y) - v*u* 4 = (w::complex)";
   7.413 -test "( 2*x*u*v + (u*v)* 4 + y) - v*u = (w::complex)";
   7.414 -test "u*v - (x*u*v + (u*v)* 4 + y) = (w::complex)";
   7.415 -
   7.416 -test "(i + j +  12 + (k::complex)) = u +  15 + y";
   7.417 -test "(i + j* 2 +  12 + (k::complex)) = j +  5 + y";
   7.418 -
   7.419 -test " 2*y +  3*z +  6*w +  2*y +  3*z +  2*u =  2*y' +  3*z' +  6*w' +  2*y' +  3*z' + u + (vv::complex)";
   7.420 -
   7.421 -test "a + -(b+c) + b = (d::complex)";
   7.422 -test "a + -(b+c) - b = (d::complex)";
   7.423 -
   7.424 -(*negative numerals*)
   7.425 -test "(i + j +  -2 + (k::complex)) - (u +  5 + y) = zz";
   7.426 -
   7.427 -test "(i + j +  -12 + (k::complex)) -  15 = y";
   7.428 -test "(i + j +  12 + (k::complex)) -  -15 = y";
   7.429 -test "(i + j +  -12 + (k::complex)) -  -15 = y";
   7.430 -
   7.431 -*)
   7.432 -
   7.433 -
   7.434 -(** Constant folding for complex plus and times **)
   7.435 -
   7.436 -structure Complex_Times_Assoc_Data : ASSOC_FOLD_DATA =
   7.437 -struct
   7.438 -  val ss		= HOL_ss
   7.439 -  val eq_reflection	= eq_reflection
   7.440 -  val sg_ref    = Sign.self_ref (Theory.sign_of (the_context ()))
   7.441 -  val T	     = Complex_Numeral_Simprocs.complexT
   7.442 -  val plus   = Const ("op *", [T,T] ---> T)
   7.443 -  val add_ac = mult_ac
   7.444 -end;
   7.445 -
   7.446 -structure Complex_Times_Assoc = Assoc_Fold (Complex_Times_Assoc_Data);
   7.447 -
   7.448 -Addsimprocs [Complex_Times_Assoc.conv];
   7.449 -
   7.450 -Addsimps [complex_of_real_zero_iff];
   7.451 -
   7.452 -
   7.453 -(*Convert???
   7.454 -Goalw [complex_number_of_def] 
   7.455 -  "((number_of xa :: complex) + ii * number_of ya = \
   7.456 -\       number_of xb) = \
   7.457 -\  (((number_of xa :: complex) = number_of xb) & \
   7.458 -\   ((number_of ya :: complex) = 0))";
   7.459 -by (auto_tac (claset(), HOL_ss addsimps [complex_eq_cancel_iff2,
   7.460 -    complex_of_real_zero_iff]));
   7.461 -qed "complex_number_of_eq_cancel_iff2";
   7.462 -Addsimps [complex_number_of_eq_cancel_iff2];
   7.463 -
   7.464 -Goalw [complex_number_of_def] 
   7.465 -  "((number_of xa :: complex) + number_of ya * ii = \
   7.466 -\       number_of xb) = \
   7.467 -\  (((number_of xa :: complex) = number_of xb) & \
   7.468 -\   ((number_of ya :: complex) = 0))";
   7.469 -by (auto_tac (claset(), HOL_ss addsimps [complex_eq_cancel_iff2a,
   7.470 -    complex_of_real_zero_iff]));
   7.471 -qed "complex_number_of_eq_cancel_iff2a";
   7.472 -Addsimps [complex_number_of_eq_cancel_iff2a];
   7.473 -
   7.474 -Goalw [complex_number_of_def] 
   7.475 -  "((number_of xa :: complex) + ii * number_of ya = \
   7.476 -\    ii * number_of yb) = \
   7.477 -\  (((number_of xa :: complex) = 0) & \
   7.478 -\   ((number_of ya :: complex) = number_of yb))";
   7.479 -by (auto_tac (claset(), HOL_ss addsimps [complex_eq_cancel_iff3,
   7.480 -    complex_of_real_zero_iff]));
   7.481 -qed "complex_number_of_eq_cancel_iff3";
   7.482 -Addsimps [complex_number_of_eq_cancel_iff3];
   7.483 -
   7.484 -Goalw [complex_number_of_def] 
   7.485 -  "((number_of xa :: complex) + number_of ya * ii= \
   7.486 -\    ii * number_of yb) = \
   7.487 -\  (((number_of xa :: complex) = 0) & \
   7.488 -\   ((number_of ya :: complex) = number_of yb))";
   7.489 -by (auto_tac (claset(), HOL_ss addsimps [complex_eq_cancel_iff3a,
   7.490 -    complex_of_real_zero_iff]));
   7.491 -qed "complex_number_of_eq_cancel_iff3a";
   7.492 -Addsimps [complex_number_of_eq_cancel_iff3a];
   7.493 -*)
   7.494 -
   7.495 -Goalw [complex_number_of_def] "cnj (number_of v :: complex) = number_of v";
   7.496 -by (rtac complex_cnj_complex_of_real 1);
   7.497 -qed "complex_number_of_cnj";
   7.498 -Addsimps [complex_number_of_cnj];
   7.499 -
   7.500 -Goalw [complex_number_of_def] 
   7.501 -      "cmod(number_of v :: complex) = abs (number_of v :: real)";
   7.502 -by (auto_tac (claset(), HOL_ss addsimps [complex_mod_complex_of_real]));
   7.503 -qed "complex_number_of_cmod";
   7.504 -Addsimps [complex_number_of_cmod];
   7.505 -
   7.506 -Goalw [complex_number_of_def] 
   7.507 -      "Re(number_of v :: complex) = number_of v";
   7.508 -by (auto_tac (claset(), HOL_ss addsimps [Re_complex_of_real]));
   7.509 -qed "complex_number_of_Re";
   7.510 -Addsimps [complex_number_of_Re];
   7.511 -
   7.512 -Goalw [complex_number_of_def] 
   7.513 -      "Im(number_of v :: complex) = 0";
   7.514 -by (auto_tac (claset(), HOL_ss addsimps [Im_complex_of_real]));
   7.515 -qed "complex_number_of_Im";
   7.516 -Addsimps [complex_number_of_Im];
   7.517 -
   7.518 -Goalw [expi_def] 
   7.519 -   "expi((2::complex) * complex_of_real pi * ii) = 1";
   7.520 -by (auto_tac (claset(),simpset() addsimps [complex_Re_mult_eq,
   7.521 -    complex_Im_mult_eq,cis_def]));
   7.522 -qed "expi_two_pi_i";
   7.523 -Addsimps [expi_two_pi_i];
   7.524 -
   7.525 -(*examples:
   7.526 -print_depth 22;
   7.527 -set timing;
   7.528 -set trace_simp;
   7.529 -fun test s = (Goal s, by (Simp_tac 1)); 
   7.530 -
   7.531 -test "23 * ii + 45 * ii= (x::complex)";
   7.532 -
   7.533 -test "5 * ii + 12 - 45 * ii= (x::complex)";
   7.534 -test "5 * ii + 40 - 12 * ii + 9 = (x::complex) + 89 * ii";
   7.535 -test "5 * ii + 40 - 12 * ii + 9 - 78 = (x::complex) + 89 * ii";
   7.536 -
   7.537 -test "l + 10 * ii + 90 + 3*l +  9 + 45 * ii= (x::complex)";
   7.538 -test "87 + 10 * ii + 90 + 3*7 +  9 + 45 * ii= (x::complex)";
   7.539 -
   7.540 -
   7.541 -*)
     8.1 --- a/src/HOL/Complex/ComplexBin.thy	Sat Feb 14 02:06:12 2004 +0100
     8.2 +++ b/src/HOL/Complex/ComplexBin.thy	Sun Feb 15 10:46:37 2004 +0100
     8.3 @@ -5,18 +5,5 @@
     8.4                  This case is reduced to that for the reals.
     8.5  *)
     8.6  
     8.7 -ComplexBin = Complex + 
     8.8 -
     8.9 -
    8.10 -instance
    8.11 -  complex :: number 
    8.12 -
    8.13 -instance complex :: plus_ac0(complex_add_commute,complex_add_assoc,complex_add_zero_left)
    8.14 +theory ComplexBin = Complex:
    8.15  
    8.16 -
    8.17 -defs
    8.18 -  complex_number_of_def
    8.19 -    "number_of v == complex_of_real (number_of v)"
    8.20 -     (*::bin=>complex               ::bin=>complex*)
    8.21 -
    8.22 -end
     9.1 --- a/src/HOL/Complex/NSCA.ML	Sat Feb 14 02:06:12 2004 +0100
     9.2 +++ b/src/HOL/Complex/NSCA.ML	Sun Feb 15 10:46:37 2004 +0100
     9.3 @@ -5,7 +5,7 @@
     9.4  *)
     9.5  
     9.6  val complex_induct = thm"complex.induct";
     9.7 -
     9.8 +val hcomplex_number_of = thm"hcomplex_number_of";
     9.9  
    9.10  (*--------------------------------------------------------------------------------------*)
    9.11  (* Closure laws for members of (embedded) set standard complex SComplex                 *)
    9.12 @@ -58,8 +58,8 @@
    9.13  qed "SReal_hcmod_hcomplex_of_complex";
    9.14  Addsimps [SReal_hcmod_hcomplex_of_complex];
    9.15  
    9.16 -Goalw [hcomplex_number_of_def]
    9.17 -    "hcmod (number_of w ::hcomplex) : Reals";
    9.18 +Goal "hcmod (number_of w ::hcomplex) : Reals";
    9.19 +by (stac (hcomplex_number_of RS sym) 1); 
    9.20  by (rtac SReal_hcmod_hcomplex_of_complex 1);
    9.21  qed "SReal_hcmod_number_of";
    9.22  Addsimps [SReal_hcmod_number_of];
    9.23 @@ -73,7 +73,8 @@
    9.24  qed "SComplex_hcomplex_of_complex";
    9.25  Addsimps [SComplex_hcomplex_of_complex];
    9.26  
    9.27 -Goalw [hcomplex_number_of_def] "(number_of w ::hcomplex) : SComplex";
    9.28 +Goal "(number_of w ::hcomplex) : SComplex";
    9.29 +by (stac (hcomplex_number_of RS sym) 1); 
    9.30  by (rtac SComplex_hcomplex_of_complex 1);
    9.31  qed "SComplex_number_of";
    9.32  Addsimps [SComplex_number_of];
    9.33 @@ -122,7 +123,7 @@
    9.34  qed "SComplex_hcmod_SReal";
    9.35  
    9.36  Goal "0 : SComplex";
    9.37 -by (auto_tac (claset(),simpset() addsimps [SComplex_def]));
    9.38 +by (auto_tac ((claset(),simpset() addsimps [SComplex_def]) addIffs [hcomplex_of_complex_zero_iff]));
    9.39  qed "SComplex_zero";
    9.40  Addsimps [SComplex_zero];
    9.41  
    9.42 @@ -206,7 +207,7 @@
    9.43  AddIffs [CInfinitesimal_zero];
    9.44  
    9.45  Goal "x/(2::hcomplex) + x/(2::hcomplex) = x";
    9.46 -by Auto_tac;  
    9.47 +by Auto_tac;
    9.48  qed "hcomplex_sum_of_halves";
    9.49  
    9.50  Goalw [CInfinitesimal_def,Infinitesimal_def] 
    9.51 @@ -954,6 +955,8 @@
    9.52      Reals_Re_Im_SComplex]) 1);
    9.53  qed "SComplex_SReal_iff";
    9.54  
    9.55 +val hcomplex_zero_num = thm"hcomplex_zero_num";
    9.56 +
    9.57  Goal "(Abs_hcomplex(hcomplexrel ``{%n. X n}) : CInfinitesimal) = \
    9.58  \     (Abs_hypreal(hyprel `` {%n. Re(X n)}) : Infinitesimal & \
    9.59  \      Abs_hypreal(hyprel `` {%n. Im(X n)}) : Infinitesimal)";
    10.1 --- a/src/HOL/Complex/NSCA.thy	Sat Feb 14 02:06:12 2004 +0100
    10.2 +++ b/src/HOL/Complex/NSCA.thy	Sun Feb 15 10:46:37 2004 +0100
    10.3 @@ -4,7 +4,7 @@
    10.4      Description : Infinite, infinitesimal complex number etc! 
    10.5  *)
    10.6  
    10.7 -NSCA = NSComplexArith + 
    10.8 +NSCA = NSComplex + 
    10.9  
   10.10  consts   
   10.11  
    11.1 --- a/src/HOL/Complex/NSComplex.thy	Sat Feb 14 02:06:12 2004 +0100
    11.2 +++ b/src/HOL/Complex/NSComplex.thy	Sun Feb 15 10:46:37 2004 +0100
    11.3 @@ -1368,8 +1368,10 @@
    11.4  lemma hcomplex_of_complex_zero [simp]: "hcomplex_of_complex 0 = 0"
    11.5  by (simp add: hcomplex_of_complex_def hcomplex_zero_def)
    11.6  
    11.7 -lemma hcomplex_of_complex_zero_iff: "(hcomplex_of_complex r = 0) = (r = 0)"
    11.8 -by (auto intro: FreeUltrafilterNat_P simp add: hcomplex_of_complex_def hcomplex_zero_def)
    11.9 +lemma hcomplex_of_complex_zero_iff [simp]:
   11.10 +     "(hcomplex_of_complex r = 0) = (r = 0)"
   11.11 +by (auto intro: FreeUltrafilterNat_P 
   11.12 +         simp add: hcomplex_of_complex_def hcomplex_zero_def)
   11.13  
   11.14  lemma hcomplex_of_complex_inverse [simp]:
   11.15       "hcomplex_of_complex (inverse r) = inverse (hcomplex_of_complex r)"
   11.16 @@ -1398,6 +1400,199 @@
   11.17       "hcmod (hcomplex_of_complex x) = hypreal_of_real (cmod x)"
   11.18  by (simp add: hypreal_of_real_def hcomplex_of_complex_def hcmod)
   11.19  
   11.20 +
   11.21 +subsection{*Numerals and Arithmetic*}
   11.22 +
   11.23 +instance hcomplex :: number ..
   11.24 +
   11.25 +primrec (*the type constraint is essential!*)
   11.26 +  number_of_Pls: "number_of bin.Pls = 0"
   11.27 +  number_of_Min: "number_of bin.Min = - (1::hcomplex)"
   11.28 +  number_of_BIT: "number_of(w BIT x) = (if x then 1 else 0) +
   11.29 +	                               (number_of w) + (number_of w)"
   11.30 +
   11.31 +declare number_of_Pls [simp del]
   11.32 +        number_of_Min [simp del]
   11.33 +        number_of_BIT [simp del]
   11.34 +
   11.35 +instance hcomplex :: number_ring
   11.36 +proof
   11.37 +  show "Numeral0 = (0::hcomplex)" by (rule number_of_Pls)
   11.38 +  show "-1 = - (1::hcomplex)" by (rule number_of_Min)
   11.39 +  fix w :: bin and x :: bool
   11.40 +  show "(number_of (w BIT x) :: hcomplex) =
   11.41 +        (if x then 1 else 0) + number_of w + number_of w"
   11.42 +    by (rule number_of_BIT)
   11.43 +qed
   11.44 +
   11.45 +
   11.46 +text{*Collapse applications of @{term hcomplex_of_complex} to @{term number_of}*}
   11.47 +lemma hcomplex_number_of [simp]:
   11.48 +     "hcomplex_of_complex (number_of w) = number_of w"
   11.49 +apply (induct w) 
   11.50 +apply (simp_all only: number_of hcomplex_of_complex_add 
   11.51 +                      hcomplex_of_complex_minus, simp_all) 
   11.52 +done
   11.53 +
   11.54 +lemma hcomplex_of_hypreal_eq_hcomplex_of_complex: 
   11.55 +     "hcomplex_of_hypreal (hypreal_of_real x) =  
   11.56 +      hcomplex_of_complex(complex_of_real x)"
   11.57 +by (simp add: hypreal_of_real_def hcomplex_of_hypreal hcomplex_of_complex_def 
   11.58 +              complex_of_real_def)
   11.59 +
   11.60 +lemma hcomplex_hypreal_number_of: 
   11.61 +  "hcomplex_of_complex (number_of w) = hcomplex_of_hypreal(number_of w)"
   11.62 +by (simp only: complex_number_of [symmetric] hypreal_number_of [symmetric] 
   11.63 +               hcomplex_of_hypreal_eq_hcomplex_of_complex)
   11.64 +
   11.65 +text{*This theorem is necessary because theorems such as
   11.66 +   @{text iszero_number_of_0} only hold for ordered rings. They cannot
   11.67 +   be generalized to fields in general because they fail for finite fields.
   11.68 +   They work for type complex because the reals can be embedded in them.*}
   11.69 +lemma iszero_hcomplex_number_of [simp]:
   11.70 +     "iszero (number_of w :: hcomplex) = iszero (number_of w :: real)"
   11.71 +apply (simp only: iszero_complex_number_of [symmetric])  
   11.72 +apply (simp only: hcomplex_of_complex_zero_iff hcomplex_number_of [symmetric] 
   11.73 +                  iszero_def)  
   11.74 +done
   11.75 +
   11.76 +
   11.77 +(*
   11.78 +Goal "z + hcnj z =  
   11.79 +      hcomplex_of_hypreal (2 * hRe(z))"
   11.80 +by (res_inst_tac [("z","z")] eq_Abs_hcomplex 1);
   11.81 +by (auto_tac (claset(),HOL_ss addsimps [hRe,hcnj,hcomplex_add,
   11.82 +    hypreal_mult,hcomplex_of_hypreal,complex_add_cnj]));
   11.83 +qed "hcomplex_add_hcnj";
   11.84 +
   11.85 +Goal "z - hcnj z = \
   11.86 +\     hcomplex_of_hypreal (hypreal_of_real #2 * hIm(z)) * iii";
   11.87 +by (res_inst_tac [("z","z")] eq_Abs_hcomplex 1);
   11.88 +by (auto_tac (claset(),simpset() addsimps [hIm,hcnj,hcomplex_diff,
   11.89 +    hypreal_of_real_def,hypreal_mult,hcomplex_of_hypreal,
   11.90 +    complex_diff_cnj,iii_def,hcomplex_mult]));
   11.91 +qed "hcomplex_diff_hcnj";
   11.92 +*)
   11.93 +
   11.94 +
   11.95 +lemma hcomplex_hcnj_num_zero_iff: "(hcnj z = 0) = (z = 0)"
   11.96 +apply (auto simp add: hcomplex_hcnj_zero_iff)
   11.97 +done
   11.98 +declare hcomplex_hcnj_num_zero_iff [simp]
   11.99 +
  11.100 +lemma hcomplex_zero_num: "0 = Abs_hcomplex (hcomplexrel `` {%n. 0})"
  11.101 +apply (simp add: hcomplex_zero_def)
  11.102 +done
  11.103 +
  11.104 +lemma hcomplex_one_num: "1 =  Abs_hcomplex (hcomplexrel `` {%n. 1})"
  11.105 +apply (simp add: hcomplex_one_def)
  11.106 +done
  11.107 +
  11.108 +(*** Real and imaginary stuff ***)
  11.109 +
  11.110 +(*Convert???
  11.111 +Goalw [hcomplex_number_of_def] 
  11.112 +  "((number_of xa :: hcomplex) + iii * number_of ya =  
  11.113 +        number_of xb + iii * number_of yb) =  
  11.114 +   (((number_of xa :: hcomplex) = number_of xb) &  
  11.115 +    ((number_of ya :: hcomplex) = number_of yb))"
  11.116 +by (auto_tac (claset(), HOL_ss addsimps [hcomplex_eq_cancel_iff,
  11.117 +     hcomplex_hypreal_number_of]));
  11.118 +qed "hcomplex_number_of_eq_cancel_iff";
  11.119 +Addsimps [hcomplex_number_of_eq_cancel_iff];
  11.120 +
  11.121 +Goalw [hcomplex_number_of_def] 
  11.122 +  "((number_of xa :: hcomplex) + number_of ya * iii = \
  11.123 +\       number_of xb + number_of yb * iii) = \
  11.124 +\  (((number_of xa :: hcomplex) = number_of xb) & \
  11.125 +\   ((number_of ya :: hcomplex) = number_of yb))";
  11.126 +by (auto_tac (claset(), HOL_ss addsimps [hcomplex_eq_cancel_iffA,
  11.127 +    hcomplex_hypreal_number_of]));
  11.128 +qed "hcomplex_number_of_eq_cancel_iffA";
  11.129 +Addsimps [hcomplex_number_of_eq_cancel_iffA];
  11.130 +
  11.131 +Goalw [hcomplex_number_of_def] 
  11.132 +  "((number_of xa :: hcomplex) + number_of ya * iii = \
  11.133 +\       number_of xb + iii * number_of yb) = \
  11.134 +\  (((number_of xa :: hcomplex) = number_of xb) & \
  11.135 +\   ((number_of ya :: hcomplex) = number_of yb))";
  11.136 +by (auto_tac (claset(), HOL_ss addsimps [hcomplex_eq_cancel_iffB,
  11.137 +    hcomplex_hypreal_number_of]));
  11.138 +qed "hcomplex_number_of_eq_cancel_iffB";
  11.139 +Addsimps [hcomplex_number_of_eq_cancel_iffB];
  11.140 +
  11.141 +Goalw [hcomplex_number_of_def] 
  11.142 +  "((number_of xa :: hcomplex) + iii * number_of ya = \
  11.143 +\       number_of xb + number_of yb * iii) = \
  11.144 +\  (((number_of xa :: hcomplex) = number_of xb) & \
  11.145 +\   ((number_of ya :: hcomplex) = number_of yb))";
  11.146 +by (auto_tac (claset(), HOL_ss addsimps [hcomplex_eq_cancel_iffC,
  11.147 +     hcomplex_hypreal_number_of]));
  11.148 +qed "hcomplex_number_of_eq_cancel_iffC";
  11.149 +Addsimps [hcomplex_number_of_eq_cancel_iffC];
  11.150 +
  11.151 +Goalw [hcomplex_number_of_def] 
  11.152 +  "((number_of xa :: hcomplex) + iii * number_of ya = \
  11.153 +\       number_of xb) = \
  11.154 +\  (((number_of xa :: hcomplex) = number_of xb) & \
  11.155 +\   ((number_of ya :: hcomplex) = 0))";
  11.156 +by (auto_tac (claset(), HOL_ss addsimps [hcomplex_eq_cancel_iff2,
  11.157 +    hcomplex_hypreal_number_of,hcomplex_of_hypreal_zero_iff]));
  11.158 +qed "hcomplex_number_of_eq_cancel_iff2";
  11.159 +Addsimps [hcomplex_number_of_eq_cancel_iff2];
  11.160 +
  11.161 +Goalw [hcomplex_number_of_def] 
  11.162 +  "((number_of xa :: hcomplex) + number_of ya * iii = \
  11.163 +\       number_of xb) = \
  11.164 +\  (((number_of xa :: hcomplex) = number_of xb) & \
  11.165 +\   ((number_of ya :: hcomplex) = 0))";
  11.166 +by (auto_tac (claset(), HOL_ss addsimps [hcomplex_eq_cancel_iff2a,
  11.167 +    hcomplex_hypreal_number_of,hcomplex_of_hypreal_zero_iff]));
  11.168 +qed "hcomplex_number_of_eq_cancel_iff2a";
  11.169 +Addsimps [hcomplex_number_of_eq_cancel_iff2a];
  11.170 +
  11.171 +Goalw [hcomplex_number_of_def] 
  11.172 +  "((number_of xa :: hcomplex) + iii * number_of ya = \
  11.173 +\    iii * number_of yb) = \
  11.174 +\  (((number_of xa :: hcomplex) = 0) & \
  11.175 +\   ((number_of ya :: hcomplex) = number_of yb))";
  11.176 +by (auto_tac (claset(), HOL_ss addsimps [hcomplex_eq_cancel_iff3,
  11.177 +    hcomplex_hypreal_number_of,hcomplex_of_hypreal_zero_iff]));
  11.178 +qed "hcomplex_number_of_eq_cancel_iff3";
  11.179 +Addsimps [hcomplex_number_of_eq_cancel_iff3];
  11.180 +
  11.181 +Goalw [hcomplex_number_of_def] 
  11.182 +  "((number_of xa :: hcomplex) + number_of ya * iii= \
  11.183 +\    iii * number_of yb) = \
  11.184 +\  (((number_of xa :: hcomplex) = 0) & \
  11.185 +\   ((number_of ya :: hcomplex) = number_of yb))";
  11.186 +by (auto_tac (claset(), HOL_ss addsimps [hcomplex_eq_cancel_iff3a,
  11.187 +    hcomplex_hypreal_number_of,hcomplex_of_hypreal_zero_iff]));
  11.188 +qed "hcomplex_number_of_eq_cancel_iff3a";
  11.189 +Addsimps [hcomplex_number_of_eq_cancel_iff3a];
  11.190 +*)
  11.191 +
  11.192 +lemma hcomplex_number_of_hcnj [simp]:
  11.193 +     "hcnj (number_of v :: hcomplex) = number_of v"
  11.194 +by (simp only: hcomplex_number_of [symmetric] hcomplex_hypreal_number_of
  11.195 +               hcomplex_hcnj_hcomplex_of_hypreal)
  11.196 +
  11.197 +lemma hcomplex_number_of_hcmod [simp]: 
  11.198 +      "hcmod(number_of v :: hcomplex) = abs (number_of v :: hypreal)"
  11.199 +by (simp only: hcomplex_number_of [symmetric] hcomplex_hypreal_number_of
  11.200 +               hcmod_hcomplex_of_hypreal)
  11.201 +
  11.202 +lemma hcomplex_number_of_hRe [simp]: 
  11.203 +      "hRe(number_of v :: hcomplex) = number_of v"
  11.204 +by (simp only: hcomplex_number_of [symmetric] hcomplex_hypreal_number_of
  11.205 +               hRe_hcomplex_of_hypreal)
  11.206 +
  11.207 +lemma hcomplex_number_of_hIm [simp]: 
  11.208 +      "hIm(number_of v :: hcomplex) = 0"
  11.209 +by (simp only: hcomplex_number_of [symmetric] hcomplex_hypreal_number_of
  11.210 +               hIm_hcomplex_of_hypreal)
  11.211 +
  11.212 +
  11.213  ML
  11.214  {*
  11.215  val hcomplex_zero_def = thm"hcomplex_zero_def";
    12.1 --- a/src/HOL/Complex/NSComplexArith.thy	Sat Feb 14 02:06:12 2004 +0100
    12.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    12.3 @@ -1,19 +0,0 @@
    12.4 -(*  Title:       NSComplexArith
    12.5 -    Author:      Lawrence C. Paulson
    12.6 -    Copyright:   2003  University of Cambridge
    12.7 -
    12.8 -Common factor cancellation
    12.9 -*)
   12.10 -
   12.11 -theory NSComplexArith = NSComplexBin
   12.12 -files "hcomplex_arith.ML":
   12.13 -
   12.14 -subsubsection{*Division By @{term "-1"}*}
   12.15 -
   12.16 -lemma hcomplex_divide_minus1 [simp]: "x/-1 = -(x::hcomplex)"
   12.17 -by simp
   12.18 -
   12.19 -lemma hcomplex_minus1_divide [simp]: "-1/(x::hcomplex) = - (1/x)"
   12.20 -by (simp add: hcomplex_divide_def inverse_minus_eq)
   12.21 -
   12.22 -end
    13.1 --- a/src/HOL/Complex/NSComplexBin.ML	Sat Feb 14 02:06:12 2004 +0100
    13.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.3 @@ -1,595 +0,0 @@
    13.4 -(*  Title:      NSComplexBin.ML
    13.5 -    Author:     Jacques D. Fleuriot
    13.6 -    Copyright:  2001 University of Edinburgh
    13.7 -    Descrition: Binary arithmetic for the nonstandard complex numbers
    13.8 -*)
    13.9 -
   13.10 -(** hcomplex_of_complex (coercion from complex to nonstandard complex) **)
   13.11 -
   13.12 -Goal "hcomplex_of_complex (number_of w) = number_of w";
   13.13 -by (simp_tac (simpset() addsimps [hcomplex_number_of_def]) 1);
   13.14 -qed "hcomplex_number_of";
   13.15 -Addsimps [hcomplex_number_of];
   13.16 -
   13.17 -Goalw [hypreal_of_real_def]
   13.18 -     "hcomplex_of_hypreal (hypreal_of_real x) = \
   13.19 -\     hcomplex_of_complex(complex_of_real x)";
   13.20 -by (simp_tac (simpset() addsimps [hcomplex_of_hypreal,
   13.21 -    hcomplex_of_complex_def,complex_of_real_def]) 1);
   13.22 -qed "hcomplex_of_hypreal_eq_hcomplex_of_complex";
   13.23 -
   13.24 -Goalw [complex_number_of_def,hypreal_number_of_def] 
   13.25 -  "hcomplex_of_complex (number_of w) = hcomplex_of_hypreal(number_of w)";
   13.26 -by (rtac (hcomplex_of_hypreal_eq_hcomplex_of_complex RS sym) 1);
   13.27 -qed "hcomplex_hypreal_number_of";
   13.28 -
   13.29 -Goalw [hcomplex_number_of_def] "Numeral0 = (0::hcomplex)";
   13.30 -by(Simp_tac 1);
   13.31 -qed "hcomplex_numeral_0_eq_0";
   13.32 -
   13.33 -Goalw [hcomplex_number_of_def] "Numeral1 = (1::hcomplex)";
   13.34 -by(Simp_tac 1);
   13.35 -qed "hcomplex_numeral_1_eq_1";
   13.36 -
   13.37 -(*
   13.38 -Goal "z + hcnj z = \
   13.39 -\     hcomplex_of_hypreal (2 * hRe(z))";
   13.40 -by (res_inst_tac [("z","z")] eq_Abs_hcomplex 1);
   13.41 -by (auto_tac (claset(),HOL_ss addsimps [hRe,hcnj,hcomplex_add,
   13.42 -    hypreal_mult,hcomplex_of_hypreal,complex_add_cnj]));
   13.43 -qed "hcomplex_add_hcnj";
   13.44 -
   13.45 -Goal "z - hcnj z = \
   13.46 -\     hcomplex_of_hypreal (hypreal_of_real #2 * hIm(z)) * iii";
   13.47 -by (res_inst_tac [("z","z")] eq_Abs_hcomplex 1);
   13.48 -by (auto_tac (claset(),simpset() addsimps [hIm,hcnj,hcomplex_diff,
   13.49 -    hypreal_of_real_def,hypreal_mult,hcomplex_of_hypreal,
   13.50 -    complex_diff_cnj,iii_def,hcomplex_mult]));
   13.51 -qed "hcomplex_diff_hcnj";
   13.52 -*)
   13.53 -
   13.54 -(** Addition **)
   13.55 -
   13.56 -Goal "(number_of v :: hcomplex) + number_of v' = number_of (bin_add v v')";
   13.57 -by (simp_tac
   13.58 -    (HOL_ss addsimps [hcomplex_number_of_def, 
   13.59 -                      hcomplex_of_complex_add RS sym, add_complex_number_of]) 1);
   13.60 -qed "add_hcomplex_number_of";
   13.61 -Addsimps [add_hcomplex_number_of];
   13.62 -
   13.63 -
   13.64 -(** Subtraction **)
   13.65 -
   13.66 -Goalw [hcomplex_number_of_def]
   13.67 -     "- (number_of w :: hcomplex) = number_of (bin_minus w)";
   13.68 -by (simp_tac
   13.69 -    (HOL_ss addsimps [minus_complex_number_of, hcomplex_of_complex_minus RS sym]) 1);
   13.70 -qed "minus_hcomplex_number_of";
   13.71 -Addsimps [minus_hcomplex_number_of];
   13.72 -
   13.73 -Goalw [hcomplex_number_of_def, hcomplex_diff_def]
   13.74 -     "(number_of v :: hcomplex) - number_of w = \
   13.75 -\     number_of (bin_add v (bin_minus w))";
   13.76 -by (Simp_tac 1); 
   13.77 -qed "diff_hcomplex_number_of";
   13.78 -Addsimps [diff_hcomplex_number_of];
   13.79 -
   13.80 -
   13.81 -(** Multiplication **)
   13.82 -
   13.83 -Goal "(number_of v :: hcomplex) * number_of v' = number_of (bin_mult v v')";
   13.84 -by (simp_tac
   13.85 -    (HOL_ss addsimps [hcomplex_number_of_def, 
   13.86 -	              hcomplex_of_complex_mult RS sym, mult_complex_number_of]) 1);
   13.87 -qed "mult_hcomplex_number_of";
   13.88 -Addsimps [mult_hcomplex_number_of];
   13.89 -
   13.90 -Goal "(2::hcomplex) = 1 + 1";
   13.91 -by (simp_tac (simpset() addsimps [hcomplex_numeral_1_eq_1 RS sym]) 1);
   13.92 -val lemma = result();
   13.93 -
   13.94 -(*For specialist use: NOT as default simprules*)
   13.95 -Goal "2 * z = (z+z::hcomplex)";
   13.96 -by (simp_tac (simpset() addsimps [lemma, hcomplex_add_mult_distrib]) 1);
   13.97 -qed "hcomplex_mult_2";
   13.98 -
   13.99 -Goal "z * 2 = (z+z::hcomplex)";
  13.100 -by (stac hcomplex_mult_commute 1 THEN rtac hcomplex_mult_2 1);
  13.101 -qed "hcomplex_mult_2_right";
  13.102 -
  13.103 -(** Equals (=) **)
  13.104 -
  13.105 -Goal "((number_of v :: hcomplex) = number_of v') = \
  13.106 -\     iszero (number_of (bin_add v (bin_minus v')) :: int)";
  13.107 -by (simp_tac
  13.108 -    (HOL_ss addsimps [hcomplex_number_of_def, 
  13.109 -	              hcomplex_of_complex_eq_iff, eq_complex_number_of]) 1);
  13.110 -qed "eq_hcomplex_number_of";
  13.111 -Addsimps [eq_hcomplex_number_of];
  13.112 -
  13.113 -(*** New versions of existing theorems involving 0, 1hc ***)
  13.114 -
  13.115 -Goal "- 1 = (-1::hcomplex)";
  13.116 -by (simp_tac (simpset() addsimps [hcomplex_numeral_1_eq_1 RS sym]) 1);
  13.117 -qed "hcomplex_minus_1_eq_m1";
  13.118 -
  13.119 -Goal "-1 * z = -(z::hcomplex)";
  13.120 -by (simp_tac (simpset() addsimps [hcomplex_minus_1_eq_m1 RS sym]) 1);
  13.121 -qed "hcomplex_mult_minus1";
  13.122 -
  13.123 -Goal "z * -1 = -(z::hcomplex)";
  13.124 -by (stac hcomplex_mult_commute 1 THEN rtac hcomplex_mult_minus1 1);
  13.125 -qed "hcomplex_mult_minus1_right";
  13.126 -
  13.127 -Addsimps [hcomplex_mult_minus1,hcomplex_mult_minus1_right];
  13.128 -
  13.129 -(*Maps 0 to Numeral0 and 1 to Numeral1 and -Numeral1 to -1*)
  13.130 -val hcomplex_numeral_ss = 
  13.131 -    complex_numeral_ss addsimps [hcomplex_numeral_0_eq_0 RS sym, hcomplex_numeral_1_eq_1 RS sym, 
  13.132 -		                 hcomplex_minus_1_eq_m1];
  13.133 -
  13.134 -fun rename_numerals th = 
  13.135 -    asm_full_simplify hcomplex_numeral_ss (Thm.transfer (the_context ()) th);
  13.136 -
  13.137 -
  13.138 -(*Now insert some identities previously stated for 0 and 1hc*)
  13.139 -
  13.140 -
  13.141 -Addsimps [hcomplex_numeral_0_eq_0,hcomplex_numeral_1_eq_1];
  13.142 -
  13.143 -Goal "number_of v + (number_of w + z) = (number_of(bin_add v w) + z::hcomplex)";
  13.144 -by (auto_tac (claset(),simpset() addsimps [hcomplex_add_assoc RS sym]));
  13.145 -qed "hcomplex_add_number_of_left";
  13.146 -
  13.147 -Goal "number_of v *(number_of w * z) = (number_of(bin_mult v w) * z::hcomplex)";
  13.148 -by (simp_tac (simpset() addsimps [hcomplex_mult_assoc RS sym]) 1);
  13.149 -qed "hcomplex_mult_number_of_left";
  13.150 -
  13.151 -Goalw [hcomplex_diff_def]
  13.152 -    "number_of v + (number_of w - c) = number_of(bin_add v w) - (c::hcomplex)";
  13.153 -by (rtac hcomplex_add_number_of_left 1);
  13.154 -qed "hcomplex_add_number_of_diff1";
  13.155 -
  13.156 -Goal "number_of v + (c - number_of w) = \
  13.157 -\     number_of (bin_add v (bin_minus w)) + (c::hcomplex)";
  13.158 -by (auto_tac (claset(),simpset() addsimps [hcomplex_diff_def]@ add_ac));
  13.159 -qed "hcomplex_add_number_of_diff2";
  13.160 -
  13.161 -Addsimps [hcomplex_add_number_of_left, hcomplex_mult_number_of_left,
  13.162 -	  hcomplex_add_number_of_diff1, hcomplex_add_number_of_diff2]; 
  13.163 -
  13.164 -
  13.165 -(**** Simprocs for numeric literals ****)
  13.166 -
  13.167 -structure HComplex_Numeral_Simprocs =
  13.168 -struct
  13.169 -
  13.170 -(*Utilities*)
  13.171 -
  13.172 -val hcomplexT = Type("NSComplex.hcomplex",[]);
  13.173 -
  13.174 -fun mk_numeral n = HOLogic.number_of_const hcomplexT $ HOLogic.mk_bin n;
  13.175 -
  13.176 -val dest_numeral = Complex_Numeral_Simprocs.dest_numeral;
  13.177 -
  13.178 -val find_first_numeral = Complex_Numeral_Simprocs.find_first_numeral;
  13.179 -
  13.180 -val zero = mk_numeral 0;
  13.181 -val mk_plus = HOLogic.mk_binop "op +";
  13.182 -
  13.183 -val uminus_const = Const ("uminus", hcomplexT --> hcomplexT);
  13.184 -
  13.185 -(*Thus mk_sum[t] yields t+0; longer sums don't have a trailing zero*)
  13.186 -fun mk_sum []        = zero
  13.187 -  | mk_sum [t,u]     = mk_plus (t, u)
  13.188 -  | mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
  13.189 -
  13.190 -(*this version ALWAYS includes a trailing zero*)
  13.191 -fun long_mk_sum []        = zero
  13.192 -  | long_mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
  13.193 -
  13.194 -val dest_plus = HOLogic.dest_bin "op +" hcomplexT;
  13.195 -
  13.196 -(*decompose additions AND subtractions as a sum*)
  13.197 -fun dest_summing (pos, Const ("op +", _) $ t $ u, ts) =
  13.198 -        dest_summing (pos, t, dest_summing (pos, u, ts))
  13.199 -  | dest_summing (pos, Const ("op -", _) $ t $ u, ts) =
  13.200 -        dest_summing (pos, t, dest_summing (not pos, u, ts))
  13.201 -  | dest_summing (pos, t, ts) =
  13.202 -	if pos then t::ts else uminus_const$t :: ts;
  13.203 -
  13.204 -fun dest_sum t = dest_summing (true, t, []);
  13.205 -
  13.206 -val mk_diff = HOLogic.mk_binop "op -";
  13.207 -val dest_diff = HOLogic.dest_bin "op -" hcomplexT;
  13.208 -
  13.209 -val one = mk_numeral 1;
  13.210 -val mk_times = HOLogic.mk_binop "op *";
  13.211 -
  13.212 -fun mk_prod [] = one
  13.213 -  | mk_prod [t] = t
  13.214 -  | mk_prod (t :: ts) = if t = one then mk_prod ts
  13.215 -                        else mk_times (t, mk_prod ts);
  13.216 -
  13.217 -val dest_times = HOLogic.dest_bin "op *" hcomplexT;
  13.218 -
  13.219 -fun dest_prod t =
  13.220 -      let val (t,u) = dest_times t 
  13.221 -      in  dest_prod t @ dest_prod u  end
  13.222 -      handle TERM _ => [t];
  13.223 -
  13.224 -(*DON'T do the obvious simplifications; that would create special cases*) 
  13.225 -fun mk_coeff (k, ts) = mk_times (mk_numeral k, ts);
  13.226 -
  13.227 -(*Express t as a product of (possibly) a numeral with other sorted terms*)
  13.228 -fun dest_coeff sign (Const ("uminus", _) $ t) = dest_coeff (~sign) t
  13.229 -  | dest_coeff sign t =
  13.230 -    let val ts = sort Term.term_ord (dest_prod t)
  13.231 -	val (n, ts') = find_first_numeral [] ts
  13.232 -                          handle TERM _ => (1, ts)
  13.233 -    in (sign*n, mk_prod ts') end;
  13.234 -
  13.235 -(*Find first coefficient-term THAT MATCHES u*)
  13.236 -fun find_first_coeff past u [] = raise TERM("find_first_coeff", []) 
  13.237 -  | find_first_coeff past u (t::terms) =
  13.238 -	let val (n,u') = dest_coeff 1 t
  13.239 -	in  if u aconv u' then (n, rev past @ terms)
  13.240 -			  else find_first_coeff (t::past) u terms
  13.241 -	end
  13.242 -	handle TERM _ => find_first_coeff (t::past) u terms;
  13.243 -
  13.244 -
  13.245 -
  13.246 -(*Simplify Numeral0+n, n+Numeral0, Numeral1*n, n*Numeral1*)
  13.247 -val add_0s = map rename_numerals [hcomplex_add_zero_left, hcomplex_add_zero_right];
  13.248 -val mult_plus_1s = map rename_numerals [hcomplex_mult_one_left, hcomplex_mult_one_right];
  13.249 -val mult_minus_1s = map rename_numerals [hcomplex_mult_minus1, hcomplex_mult_minus1_right];
  13.250 -val mult_1s = mult_plus_1s @ mult_minus_1s;
  13.251 -
  13.252 -(*To perform binary arithmetic*)
  13.253 -val bin_simps =
  13.254 -    [hcomplex_numeral_0_eq_0 RS sym, hcomplex_numeral_1_eq_1 RS sym,
  13.255 -     add_hcomplex_number_of, hcomplex_add_number_of_left, 
  13.256 -     minus_hcomplex_number_of, diff_hcomplex_number_of, mult_hcomplex_number_of, 
  13.257 -     hcomplex_mult_number_of_left] @ bin_arith_simps @ bin_rel_simps;
  13.258 -
  13.259 -(*Binary arithmetic BUT NOT ADDITION since it may collapse adjacent terms
  13.260 -  during re-arrangement*)
  13.261 -val non_add_bin_simps = 
  13.262 -    bin_simps \\ [hcomplex_add_number_of_left, add_hcomplex_number_of];
  13.263 -
  13.264 -(*To evaluate binary negations of coefficients*)
  13.265 -val hcomplex_minus_simps = NCons_simps @
  13.266 -                   [hcomplex_minus_1_eq_m1,minus_hcomplex_number_of, 
  13.267 -		    bin_minus_1, bin_minus_0, bin_minus_Pls, bin_minus_Min,
  13.268 -		    bin_pred_1, bin_pred_0, bin_pred_Pls, bin_pred_Min];
  13.269 -
  13.270 -
  13.271 -(*To let us treat subtraction as addition*)
  13.272 -val diff_simps = [hcomplex_diff_def, minus_add_distrib, minus_minus];
  13.273 -
  13.274 -(*push the unary minus down: - x * y = x * - y *)
  13.275 -val hcomplex_minus_mult_eq_1_to_2 = 
  13.276 -    [minus_mult_left RS sym, minus_mult_right] MRS trans 
  13.277 -    |> standard;
  13.278 -
  13.279 -(*to extract again any uncancelled minuses*)
  13.280 -val hcomplex_minus_from_mult_simps = 
  13.281 -    [minus_minus, minus_mult_left RS sym, minus_mult_right RS sym];
  13.282 -
  13.283 -(*combine unary minus with numeric literals, however nested within a product*)
  13.284 -val hcomplex_mult_minus_simps =
  13.285 -    [hcomplex_mult_assoc, minus_mult_left, hcomplex_minus_mult_eq_1_to_2];
  13.286 -
  13.287 -(*Final simplification: cancel + and *  *)
  13.288 -val simplify_meta_eq = 
  13.289 -    Int_Numeral_Simprocs.simplify_meta_eq
  13.290 -         [add_zero_left, add_zero_right,
  13.291 - 	  mult_zero_left, mult_zero_right, mult_1, mult_1_right];
  13.292 -
  13.293 -val prep_simproc = Complex_Numeral_Simprocs.prep_simproc;
  13.294 -
  13.295 -
  13.296 -structure CancelNumeralsCommon =
  13.297 -  struct
  13.298 -  val mk_sum    	= mk_sum
  13.299 -  val dest_sum		= dest_sum
  13.300 -  val mk_coeff		= mk_coeff
  13.301 -  val dest_coeff	= dest_coeff 1
  13.302 -  val find_first_coeff	= find_first_coeff []
  13.303 -  val trans_tac         = Real_Numeral_Simprocs.trans_tac
  13.304 -  val norm_tac = 
  13.305 -     ALLGOALS (simp_tac (HOL_ss addsimps add_0s@mult_1s@diff_simps@
  13.306 -                                         hcomplex_minus_simps@add_ac))
  13.307 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps non_add_bin_simps@hcomplex_mult_minus_simps))
  13.308 -     THEN ALLGOALS
  13.309 -              (simp_tac (HOL_ss addsimps hcomplex_minus_from_mult_simps@
  13.310 -                                         add_ac@mult_ac))
  13.311 -  val numeral_simp_tac	= ALLGOALS (simp_tac (HOL_ss addsimps add_0s@bin_simps))
  13.312 -  val simplify_meta_eq  = simplify_meta_eq
  13.313 -  end;
  13.314 -
  13.315 -
  13.316 -structure EqCancelNumerals = CancelNumeralsFun
  13.317 - (open CancelNumeralsCommon
  13.318 -  val prove_conv = Bin_Simprocs.prove_conv
  13.319 -  val mk_bal   = HOLogic.mk_eq
  13.320 -  val dest_bal = HOLogic.dest_bin "op =" hcomplexT
  13.321 -  val bal_add1 = eq_add_iff1 RS trans
  13.322 -  val bal_add2 = eq_add_iff2 RS trans
  13.323 -);
  13.324 -
  13.325 -
  13.326 -val cancel_numerals = 
  13.327 -  map prep_simproc
  13.328 -   [("hcomplexeq_cancel_numerals",
  13.329 -      ["(l::hcomplex) + m = n", "(l::hcomplex) = m + n", 
  13.330 -		"(l::hcomplex) - m = n", "(l::hcomplex) = m - n", 
  13.331 -		"(l::hcomplex) * m = n", "(l::hcomplex) = m * n"], 
  13.332 -     EqCancelNumerals.proc)];
  13.333 -
  13.334 -structure CombineNumeralsData =
  13.335 -  struct
  13.336 -  val add		= op + : int*int -> int 
  13.337 -  val mk_sum    	= long_mk_sum    (*to work for e.g. #2*x + #3*x *)
  13.338 -  val dest_sum		= dest_sum
  13.339 -  val mk_coeff		= mk_coeff
  13.340 -  val dest_coeff	= dest_coeff 1
  13.341 -  val left_distrib	= combine_common_factor RS trans
  13.342 -  val prove_conv	= Bin_Simprocs.prove_conv_nohyps
  13.343 -  val trans_tac         = Real_Numeral_Simprocs.trans_tac
  13.344 -  val norm_tac = 
  13.345 -     ALLGOALS (simp_tac (HOL_ss addsimps add_0s@mult_1s@diff_simps@
  13.346 -                                         hcomplex_minus_simps@add_ac))
  13.347 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps non_add_bin_simps@hcomplex_mult_minus_simps))
  13.348 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps hcomplex_minus_from_mult_simps@
  13.349 -                                              add_ac@mult_ac))
  13.350 -  val numeral_simp_tac	= ALLGOALS 
  13.351 -                    (simp_tac (HOL_ss addsimps add_0s@bin_simps))
  13.352 -  val simplify_meta_eq  = simplify_meta_eq
  13.353 -  end;
  13.354 -
  13.355 -structure CombineNumerals = CombineNumeralsFun(CombineNumeralsData);
  13.356 -
  13.357 -val combine_numerals = 
  13.358 -    prep_simproc ("hcomplex_combine_numerals",
  13.359 -		  ["(i::hcomplex) + j", "(i::hcomplex) - j"],
  13.360 -		  CombineNumerals.proc);
  13.361 -
  13.362 -(** Declarations for ExtractCommonTerm **)
  13.363 -
  13.364 -(*this version ALWAYS includes a trailing one*)
  13.365 -fun long_mk_prod []        = one
  13.366 -  | long_mk_prod (t :: ts) = mk_times (t, mk_prod ts);
  13.367 -
  13.368 -(*Find first term that matches u*)
  13.369 -fun find_first past u []         = raise TERM("find_first", []) 
  13.370 -  | find_first past u (t::terms) =
  13.371 -	if u aconv t then (rev past @ terms)
  13.372 -        else find_first (t::past) u terms
  13.373 -	handle TERM _ => find_first (t::past) u terms;
  13.374 -
  13.375 -(*Final simplification: cancel + and *  *)
  13.376 -fun cancel_simplify_meta_eq cancel_th th = 
  13.377 -    Int_Numeral_Simprocs.simplify_meta_eq 
  13.378 -        [hcomplex_mult_one_left, hcomplex_mult_one_right] 
  13.379 -        (([th, cancel_th]) MRS trans);
  13.380 -
  13.381 -(*** Making constant folding work for 0 and 1 too ***)
  13.382 -
  13.383 -structure HComplexAbstractNumeralsData =
  13.384 -  struct
  13.385 -  val dest_eq         = HOLogic.dest_eq o HOLogic.dest_Trueprop o concl_of
  13.386 -  val is_numeral      = Bin_Simprocs.is_numeral
  13.387 -  val numeral_0_eq_0  = hcomplex_numeral_0_eq_0
  13.388 -  val numeral_1_eq_1  = hcomplex_numeral_1_eq_1
  13.389 -  val prove_conv      = Bin_Simprocs.prove_conv_nohyps_novars
  13.390 -  fun norm_tac simps  = ALLGOALS (simp_tac (HOL_ss addsimps simps))
  13.391 -  val simplify_meta_eq = Bin_Simprocs.simplify_meta_eq
  13.392 -  end
  13.393 -
  13.394 -structure HComplexAbstractNumerals = AbstractNumeralsFun (HComplexAbstractNumeralsData)
  13.395 -
  13.396 -(*For addition, we already have rules for the operand 0.
  13.397 -  Multiplication is omitted because there are already special rules for
  13.398 -  both 0 and 1 as operands.  Unary minus is trivial, just have - 1 = -1.
  13.399 -  For the others, having three patterns is a compromise between just having
  13.400 -  one (many spurious calls) and having nine (just too many!) *)
  13.401 -val eval_numerals =
  13.402 -  map prep_simproc
  13.403 -   [("hcomplex_add_eval_numerals",
  13.404 -     ["(m::hcomplex) + 1", "(m::hcomplex) + number_of v"],
  13.405 -     HComplexAbstractNumerals.proc add_hcomplex_number_of),
  13.406 -    ("hcomplex_diff_eval_numerals",
  13.407 -     ["(m::hcomplex) - 1", "(m::hcomplex) - number_of v"],
  13.408 -     HComplexAbstractNumerals.proc diff_hcomplex_number_of),
  13.409 -    ("hcomplex_eq_eval_numerals",
  13.410 -     ["(m::hcomplex) = 0", "(m::hcomplex) = 1", "(m::hcomplex) = number_of v"],
  13.411 -     HComplexAbstractNumerals.proc eq_hcomplex_number_of)]
  13.412 -
  13.413 -end;
  13.414 -
  13.415 -Addsimprocs HComplex_Numeral_Simprocs.eval_numerals;
  13.416 -Addsimprocs HComplex_Numeral_Simprocs.cancel_numerals;
  13.417 -Addsimprocs [HComplex_Numeral_Simprocs.combine_numerals];
  13.418 -
  13.419 -
  13.420 -(*examples:
  13.421 -print_depth 22;
  13.422 -set timing;
  13.423 -set trace_simp;
  13.424 -fun test s = (Goal s, by (Simp_tac 1)); 
  13.425 -
  13.426 -test "l +  2 +  2 +  2 + (l +  2) + (oo +  2) = (uu::hcomplex)";
  13.427 -test " 2*u = (u::hcomplex)";
  13.428 -test "(i + j + 12 + (k::hcomplex)) - 15 = y";
  13.429 -test "(i + j + 12 + (k::hcomplex)) -  5 = y";
  13.430 -
  13.431 -test "( 2*x - (u*v) + y) - v* 3*u = (w::hcomplex)";
  13.432 -test "( 2*x*u*v + (u*v)* 4 + y) - v*u* 4 = (w::hcomplex)";
  13.433 -test "( 2*x*u*v + (u*v)* 4 + y) - v*u = (w::hcomplex)";
  13.434 -test "u*v - (x*u*v + (u*v)* 4 + y) = (w::hcomplex)";
  13.435 -
  13.436 -test "(i + j + 12 + (k::hcomplex)) = u + 15 + y";
  13.437 -test "(i + j* 2 + 12 + (k::hcomplex)) = j +  5 + y";
  13.438 -
  13.439 -test " 2*y +  3*z +  6*w +  2*y +  3*z +  2*u =  2*y' +  3*z' +  6*w' +  2*y' +  3*z' + u + (vv::hcomplex)";
  13.440 -
  13.441 -test "a + -(b+c) + b = (d::hcomplex)";
  13.442 -test "a + -(b+c) - b = (d::hcomplex)";
  13.443 -
  13.444 -(*negative numerals*)
  13.445 -test "(i + j +  -2 + (k::hcomplex)) - (u +  5 + y) = zz";
  13.446 -
  13.447 -test "(i + j +  -12 + (k::hcomplex)) - 15 = y";
  13.448 -test "(i + j + 12 + (k::hcomplex)) -  -15 = y";
  13.449 -test "(i + j +  -12 + (k::hcomplex)) - -15 = y";
  13.450 -*)
  13.451 -
  13.452 -(** Constant folding for hcomplex plus and times **)
  13.453 -
  13.454 -structure HComplex_Times_Assoc_Data : ASSOC_FOLD_DATA =
  13.455 -struct
  13.456 -  val ss		= HOL_ss
  13.457 -  val eq_reflection	= eq_reflection
  13.458 -  val sg_ref    = Sign.self_ref (Theory.sign_of (the_context ()))
  13.459 -  val T	     = HComplex_Numeral_Simprocs.hcomplexT
  13.460 -  val plus   = Const ("op *", [T,T] ---> T)
  13.461 -  val add_ac = mult_ac
  13.462 -end;
  13.463 -
  13.464 -structure HComplex_Times_Assoc = Assoc_Fold (HComplex_Times_Assoc_Data);
  13.465 -
  13.466 -Addsimprocs [HComplex_Times_Assoc.conv];
  13.467 -
  13.468 -Addsimps [hcomplex_of_complex_zero_iff];
  13.469 -
  13.470 -
  13.471 -(** extra thms **)
  13.472 -
  13.473 -Goal "(hcnj z = 0) = (z = 0)";
  13.474 -by (auto_tac (claset(),simpset() addsimps [hcomplex_hcnj_zero_iff]));
  13.475 -qed "hcomplex_hcnj_num_zero_iff";
  13.476 -Addsimps [hcomplex_hcnj_num_zero_iff];
  13.477 -
  13.478 -Goal "0 = Abs_hcomplex (hcomplexrel `` {%n. 0})";
  13.479 -by (simp_tac (simpset() addsimps [hcomplex_zero_def RS meta_eq_to_obj_eq RS sym]) 1);
  13.480 -qed "hcomplex_zero_num";
  13.481 -
  13.482 -Goal "1 =  Abs_hcomplex (hcomplexrel `` {%n. 1})";
  13.483 -by (simp_tac (simpset() addsimps [hcomplex_one_def RS meta_eq_to_obj_eq RS sym]) 1);
  13.484 -qed "hcomplex_one_num";
  13.485 -
  13.486 -(*** Real and imaginary stuff ***)
  13.487 -
  13.488 -(*Convert???
  13.489 -Goalw [hcomplex_number_of_def] 
  13.490 -  "((number_of xa :: hcomplex) + iii * number_of ya = \
  13.491 -\       number_of xb + iii * number_of yb) = \
  13.492 -\  (((number_of xa :: hcomplex) = number_of xb) & \
  13.493 -\   ((number_of ya :: hcomplex) = number_of yb))";
  13.494 -by (auto_tac (claset(), HOL_ss addsimps [hcomplex_eq_cancel_iff,
  13.495 -     hcomplex_hypreal_number_of]));
  13.496 -qed "hcomplex_number_of_eq_cancel_iff";
  13.497 -Addsimps [hcomplex_number_of_eq_cancel_iff];
  13.498 -
  13.499 -Goalw [hcomplex_number_of_def] 
  13.500 -  "((number_of xa :: hcomplex) + number_of ya * iii = \
  13.501 -\       number_of xb + number_of yb * iii) = \
  13.502 -\  (((number_of xa :: hcomplex) = number_of xb) & \
  13.503 -\   ((number_of ya :: hcomplex) = number_of yb))";
  13.504 -by (auto_tac (claset(), HOL_ss addsimps [hcomplex_eq_cancel_iffA,
  13.505 -    hcomplex_hypreal_number_of]));
  13.506 -qed "hcomplex_number_of_eq_cancel_iffA";
  13.507 -Addsimps [hcomplex_number_of_eq_cancel_iffA];
  13.508 -
  13.509 -Goalw [hcomplex_number_of_def] 
  13.510 -  "((number_of xa :: hcomplex) + number_of ya * iii = \
  13.511 -\       number_of xb + iii * number_of yb) = \
  13.512 -\  (((number_of xa :: hcomplex) = number_of xb) & \
  13.513 -\   ((number_of ya :: hcomplex) = number_of yb))";
  13.514 -by (auto_tac (claset(), HOL_ss addsimps [hcomplex_eq_cancel_iffB,
  13.515 -    hcomplex_hypreal_number_of]));
  13.516 -qed "hcomplex_number_of_eq_cancel_iffB";
  13.517 -Addsimps [hcomplex_number_of_eq_cancel_iffB];
  13.518 -
  13.519 -Goalw [hcomplex_number_of_def] 
  13.520 -  "((number_of xa :: hcomplex) + iii * number_of ya = \
  13.521 -\       number_of xb + number_of yb * iii) = \
  13.522 -\  (((number_of xa :: hcomplex) = number_of xb) & \
  13.523 -\   ((number_of ya :: hcomplex) = number_of yb))";
  13.524 -by (auto_tac (claset(), HOL_ss addsimps [hcomplex_eq_cancel_iffC,
  13.525 -     hcomplex_hypreal_number_of]));
  13.526 -qed "hcomplex_number_of_eq_cancel_iffC";
  13.527 -Addsimps [hcomplex_number_of_eq_cancel_iffC];
  13.528 -
  13.529 -Goalw [hcomplex_number_of_def] 
  13.530 -  "((number_of xa :: hcomplex) + iii * number_of ya = \
  13.531 -\       number_of xb) = \
  13.532 -\  (((number_of xa :: hcomplex) = number_of xb) & \
  13.533 -\   ((number_of ya :: hcomplex) = 0))";
  13.534 -by (auto_tac (claset(), HOL_ss addsimps [hcomplex_eq_cancel_iff2,
  13.535 -    hcomplex_hypreal_number_of,hcomplex_of_hypreal_zero_iff]));
  13.536 -qed "hcomplex_number_of_eq_cancel_iff2";
  13.537 -Addsimps [hcomplex_number_of_eq_cancel_iff2];
  13.538 -
  13.539 -Goalw [hcomplex_number_of_def] 
  13.540 -  "((number_of xa :: hcomplex) + number_of ya * iii = \
  13.541 -\       number_of xb) = \
  13.542 -\  (((number_of xa :: hcomplex) = number_of xb) & \
  13.543 -\   ((number_of ya :: hcomplex) = 0))";
  13.544 -by (auto_tac (claset(), HOL_ss addsimps [hcomplex_eq_cancel_iff2a,
  13.545 -    hcomplex_hypreal_number_of,hcomplex_of_hypreal_zero_iff]));
  13.546 -qed "hcomplex_number_of_eq_cancel_iff2a";
  13.547 -Addsimps [hcomplex_number_of_eq_cancel_iff2a];
  13.548 -
  13.549 -Goalw [hcomplex_number_of_def] 
  13.550 -  "((number_of xa :: hcomplex) + iii * number_of ya = \
  13.551 -\    iii * number_of yb) = \
  13.552 -\  (((number_of xa :: hcomplex) = 0) & \
  13.553 -\   ((number_of ya :: hcomplex) = number_of yb))";
  13.554 -by (auto_tac (claset(), HOL_ss addsimps [hcomplex_eq_cancel_iff3,
  13.555 -    hcomplex_hypreal_number_of,hcomplex_of_hypreal_zero_iff]));
  13.556 -qed "hcomplex_number_of_eq_cancel_iff3";
  13.557 -Addsimps [hcomplex_number_of_eq_cancel_iff3];
  13.558 -
  13.559 -Goalw [hcomplex_number_of_def] 
  13.560 -  "((number_of xa :: hcomplex) + number_of ya * iii= \
  13.561 -\    iii * number_of yb) = \
  13.562 -\  (((number_of xa :: hcomplex) = 0) & \
  13.563 -\   ((number_of ya :: hcomplex) = number_of yb))";
  13.564 -by (auto_tac (claset(), HOL_ss addsimps [hcomplex_eq_cancel_iff3a,
  13.565 -    hcomplex_hypreal_number_of,hcomplex_of_hypreal_zero_iff]));
  13.566 -qed "hcomplex_number_of_eq_cancel_iff3a";
  13.567 -Addsimps [hcomplex_number_of_eq_cancel_iff3a];
  13.568 -*)
  13.569 -
  13.570 -Goalw [hcomplex_number_of_def] "hcnj (number_of v :: hcomplex) = number_of v";
  13.571 -by (rtac (hcomplex_hypreal_number_of RS ssubst) 1);
  13.572 -by (rtac hcomplex_hcnj_hcomplex_of_hypreal 1);
  13.573 -qed "hcomplex_number_of_hcnj";
  13.574 -Addsimps [hcomplex_number_of_hcnj];
  13.575 -
  13.576 -Goalw [hcomplex_number_of_def] 
  13.577 -      "hcmod(number_of v :: hcomplex) = abs (number_of v :: hypreal)";
  13.578 -by (rtac (hcomplex_hypreal_number_of RS ssubst) 1);
  13.579 -by (auto_tac (claset(), HOL_ss addsimps [hcmod_hcomplex_of_hypreal]));
  13.580 -qed "hcomplex_number_of_hcmod";
  13.581 -Addsimps [hcomplex_number_of_hcmod];
  13.582 -
  13.583 -Goalw [hcomplex_number_of_def] 
  13.584 -      "hRe(number_of v :: hcomplex) = number_of v";
  13.585 -by (rtac (hcomplex_hypreal_number_of RS ssubst) 1);
  13.586 -by (auto_tac (claset(), HOL_ss addsimps [hRe_hcomplex_of_hypreal]));
  13.587 -qed "hcomplex_number_of_hRe";
  13.588 -Addsimps [hcomplex_number_of_hRe];
  13.589 -
  13.590 -Goalw [hcomplex_number_of_def] 
  13.591 -      "hIm(number_of v :: hcomplex) = 0";
  13.592 -by (rtac (hcomplex_hypreal_number_of RS ssubst) 1);
  13.593 -by (auto_tac (claset(), HOL_ss addsimps [hIm_hcomplex_of_hypreal]));
  13.594 -qed "hcomplex_number_of_hIm";
  13.595 -Addsimps [hcomplex_number_of_hIm];
  13.596 -
  13.597 -
  13.598 -
    14.1 --- a/src/HOL/Complex/NSComplexBin.thy	Sat Feb 14 02:06:12 2004 +0100
    14.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    14.3 @@ -1,19 +0,0 @@
    14.4 -(*  Title:      NSComplexBin.thy
    14.5 -    Author:     Jacques D. Fleuriot
    14.6 -    Copyright:  2001 University of Edinburgh
    14.7 -    Descrition: Binary arithmetic for the nonstandard complex numbers
    14.8 -                This case is reduced to that for the complexes (hence reals).
    14.9 -*)
   14.10 -
   14.11 -NSComplexBin = NSComplex + 
   14.12 -
   14.13 -
   14.14 -instance
   14.15 -  hcomplex :: number 
   14.16 -
   14.17 -defs
   14.18 -  hcomplex_number_of_def
   14.19 -    "number_of v == hcomplex_of_complex (number_of v)"
   14.20 -     (*::bin=>complex               ::bin=>complex*)
   14.21 -
   14.22 -end
   14.23 \ No newline at end of file
    15.1 --- a/src/HOL/Complex/NSInduct.thy	Sat Feb 14 02:06:12 2004 +0100
    15.2 +++ b/src/HOL/Complex/NSInduct.thy	Sun Feb 15 10:46:37 2004 +0100
    15.3 @@ -4,7 +4,7 @@
    15.4      Description: Nonstandard characterization of induction etc.
    15.5  *)
    15.6  
    15.7 -NSInduct =  ComplexArith0 + 
    15.8 +NSInduct =  Complex + 
    15.9  
   15.10  constdefs
   15.11  
    16.1 --- a/src/HOL/Complex/hcomplex_arith.ML	Sat Feb 14 02:06:12 2004 +0100
    16.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    16.3 @@ -1,164 +0,0 @@
    16.4 -(*  Title:       hcomplex_arith.ML
    16.5 -    Author:      Jacques D. Fleuriot
    16.6 -    Copyright:   2001  University of Edinburgh
    16.7 -
    16.8 -Common factor cancellation
    16.9 -*)
   16.10 -
   16.11 -local
   16.12 -  open HComplex_Numeral_Simprocs
   16.13 -in
   16.14 -
   16.15 -val rel_hcomplex_number_of = [eq_hcomplex_number_of];
   16.16 -
   16.17 -
   16.18 -structure CancelNumeralFactorCommon =
   16.19 -  struct
   16.20 -  val mk_coeff		= mk_coeff
   16.21 -  val dest_coeff	= dest_coeff 1
   16.22 -  val trans_tac         = Real_Numeral_Simprocs.trans_tac
   16.23 -  val norm_tac = ALLGOALS (simp_tac (HOL_ss addsimps hcomplex_minus_from_mult_simps @ mult_1s))
   16.24 -                 THEN ALLGOALS (simp_tac (HOL_ss addsimps bin_simps@hcomplex_mult_minus_simps))
   16.25 -                 THEN ALLGOALS (simp_tac (HOL_ss addsimps mult_ac))
   16.26 -  val numeral_simp_tac	= 
   16.27 -         ALLGOALS (simp_tac (HOL_ss addsimps rel_hcomplex_number_of@bin_simps))
   16.28 -  val simplify_meta_eq  = simplify_meta_eq
   16.29 -  end
   16.30 -
   16.31 -
   16.32 -structure DivCancelNumeralFactor = CancelNumeralFactorFun
   16.33 - (open CancelNumeralFactorCommon
   16.34 -  val prove_conv = Bin_Simprocs.prove_conv
   16.35 -  val mk_bal   = HOLogic.mk_binop "HOL.divide"
   16.36 -  val dest_bal = HOLogic.dest_bin "HOL.divide" hcomplexT
   16.37 -  val cancel = mult_divide_cancel_left RS trans
   16.38 -  val neg_exchanges = false
   16.39 -)
   16.40 -
   16.41 -
   16.42 -structure EqCancelNumeralFactor = CancelNumeralFactorFun
   16.43 - (open CancelNumeralFactorCommon
   16.44 -  val prove_conv = Bin_Simprocs.prove_conv
   16.45 -  val mk_bal   = HOLogic.mk_eq
   16.46 -  val dest_bal = HOLogic.dest_bin "op =" hcomplexT
   16.47 -  val cancel = field_mult_cancel_left RS trans
   16.48 -  val neg_exchanges = false
   16.49 -)
   16.50 -
   16.51 -
   16.52 -val hcomplex_cancel_numeral_factors_relations = 
   16.53 -  map prep_simproc
   16.54 -   [("hcomplexeq_cancel_numeral_factor",
   16.55 -    ["(l::hcomplex) * m = n", "(l::hcomplex) = m * n"], 
   16.56 -     EqCancelNumeralFactor.proc)];
   16.57 -
   16.58 -val hcomplex_cancel_numeral_factors_divide = prep_simproc
   16.59 -	("hcomplexdiv_cancel_numeral_factor", 
   16.60 -	 ["((l::hcomplex) * m) / n", "(l::hcomplex) / (m * n)", 
   16.61 -                     "((number_of v)::hcomplex) / (number_of w)"], 
   16.62 -	 DivCancelNumeralFactor.proc);
   16.63 -
   16.64 -val hcomplex_cancel_numeral_factors = 
   16.65 -    hcomplex_cancel_numeral_factors_relations @ 
   16.66 -    [hcomplex_cancel_numeral_factors_divide];
   16.67 -
   16.68 -end;
   16.69 -
   16.70 -
   16.71 -Addsimprocs hcomplex_cancel_numeral_factors;
   16.72 -
   16.73 -
   16.74 -(*examples:
   16.75 -print_depth 22;
   16.76 -set timing;
   16.77 -set trace_simp;
   16.78 -fun test s = (Goal s; by (Simp_tac 1)); 
   16.79 -
   16.80 -
   16.81 -test "#9*x = #12 * (y::hcomplex)";
   16.82 -test "(#9*x) / (#12 * (y::hcomplex)) = z";
   16.83 -
   16.84 -test "#-99*x = #132 * (y::hcomplex)";
   16.85 -
   16.86 -test "#999*x = #-396 * (y::hcomplex)";
   16.87 -test "(#999*x) / (#-396 * (y::hcomplex)) = z";
   16.88 -
   16.89 -test "#-99*x = #-81 * (y::hcomplex)";
   16.90 -test "(#-99*x) / (#-81 * (y::hcomplex)) = z";
   16.91 -
   16.92 -test "#-2 * x = #-1 * (y::hcomplex)";
   16.93 -test "#-2 * x = -(y::hcomplex)";
   16.94 -test "(#-2 * x) / (#-1 * (y::hcomplex)) = z";
   16.95 -
   16.96 -*)
   16.97 -
   16.98 -
   16.99 -(** Declarations for ExtractCommonTerm **)
  16.100 -
  16.101 -local
  16.102 -  open HComplex_Numeral_Simprocs
  16.103 -in
  16.104 -
  16.105 -structure CancelFactorCommon =
  16.106 -  struct
  16.107 -  val mk_sum    	= long_mk_prod
  16.108 -  val dest_sum		= dest_prod
  16.109 -  val mk_coeff		= mk_coeff
  16.110 -  val dest_coeff	= dest_coeff
  16.111 -  val find_first	= find_first []
  16.112 -  val trans_tac         = Real_Numeral_Simprocs.trans_tac
  16.113 -  val norm_tac = ALLGOALS (simp_tac (HOL_ss addsimps mult_1s@mult_ac))
  16.114 -  end;
  16.115 -
  16.116 -
  16.117 -structure EqCancelFactor = ExtractCommonTermFun
  16.118 - (open CancelFactorCommon
  16.119 -  val prove_conv = Bin_Simprocs.prove_conv
  16.120 -  val mk_bal   = HOLogic.mk_eq
  16.121 -  val dest_bal = HOLogic.dest_bin "op =" hcomplexT
  16.122 -  val simplify_meta_eq  = cancel_simplify_meta_eq field_mult_cancel_left
  16.123 -);
  16.124 -
  16.125 -
  16.126 -structure DivideCancelFactor = ExtractCommonTermFun
  16.127 - (open CancelFactorCommon
  16.128 -  val prove_conv = Bin_Simprocs.prove_conv
  16.129 -  val mk_bal   = HOLogic.mk_binop "HOL.divide"
  16.130 -  val dest_bal = HOLogic.dest_bin "HOL.divide" hcomplexT
  16.131 -  val simplify_meta_eq  = cancel_simplify_meta_eq mult_divide_cancel_eq_if
  16.132 -);
  16.133 -
  16.134 -val hcomplex_cancel_factor = 
  16.135 -  map prep_simproc
  16.136 -   [("hcomplex_eq_cancel_factor", ["(l::hcomplex) * m = n", "(l::hcomplex) = m * n"], 
  16.137 -     EqCancelFactor.proc),
  16.138 -    ("hcomplex_divide_cancel_factor", ["((l::hcomplex) * m) / n", "(l::hcomplex) / (m * n)"], 
  16.139 -     DivideCancelFactor.proc)];
  16.140 -
  16.141 -end;
  16.142 -
  16.143 -Addsimprocs hcomplex_cancel_factor;
  16.144 -
  16.145 -
  16.146 -(*examples:
  16.147 -print_depth 22;
  16.148 -set timing;
  16.149 -set trace_simp;
  16.150 -fun test s = (Goal s; by (Asm_simp_tac 1)); 
  16.151 -
  16.152 -test "x*k = k*(y::hcomplex)";
  16.153 -test "k = k*(y::hcomplex)"; 
  16.154 -test "a*(b*c) = (b::hcomplex)";
  16.155 -test "a*(b*c) = d*(b::hcomplex)*(x*a)";
  16.156 -
  16.157 -
  16.158 -test "(x*k) / (k*(y::hcomplex)) = (uu::hcomplex)";
  16.159 -test "(k) / (k*(y::hcomplex)) = (uu::hcomplex)"; 
  16.160 -test "(a*(b*c)) / ((b::hcomplex)) = (uu::hcomplex)";
  16.161 -test "(a*(b*c)) / (d*(b::hcomplex)*(x*a)) = (uu::hcomplex)";
  16.162 -
  16.163 -(*FIXME: what do we do about this?*)
  16.164 -test "a*(b*c)/(y*z) = d*(b::hcomplex)*(x*a)/z";
  16.165 -*)
  16.166 -
  16.167 -
    17.1 --- a/src/HOL/Hyperreal/HSeries.ML	Sat Feb 14 02:06:12 2004 +0100
    17.2 +++ b/src/HOL/Hyperreal/HSeries.ML	Sun Feb 15 10:46:37 2004 +0100
    17.3 @@ -183,8 +183,7 @@
    17.4  
    17.5  Goalw [hypnat_omega_def,hypnat_zero_def,omega_def]  
    17.6       "sumhr(0, whn, %i. 1) = omega - 1";
    17.7 -by (simp_tac (HOL_ss addsimps
    17.8 -             [hypreal_numeral_1_eq_1, hypreal_one_def]) 1); 
    17.9 +by (simp_tac (HOL_ss addsimps [numeral_1_eq_1, hypreal_one_def]) 1); 
   17.10  by (auto_tac (claset(),
   17.11                simpset() addsimps [sumhr, hypreal_diff, real_of_nat_Suc]));
   17.12  qed "sumhr_hypreal_omega_minus_one";
    18.1 --- a/src/HOL/Hyperreal/HyperArith.thy	Sat Feb 14 02:06:12 2004 +0100
    18.2 +++ b/src/HOL/Hyperreal/HyperArith.thy	Sun Feb 15 10:46:37 2004 +0100
    18.3 @@ -9,132 +9,39 @@
    18.4  theory HyperArith = HyperDef
    18.5  files ("hypreal_arith.ML"):
    18.6  
    18.7 -subsection{*Binary Arithmetic for the Hyperreals*}
    18.8 +
    18.9 +subsection{*Numerals and Arithmetic*}
   18.10  
   18.11  instance hypreal :: number ..
   18.12  
   18.13 -defs (overloaded)
   18.14 -  hypreal_number_of_def:
   18.15 -    "number_of v == hypreal_of_real (number_of v)"
   18.16 -     (*::bin=>hypreal               ::bin=>real*)
   18.17 -     --{*This case is reduced to that for the reals.*}
   18.18 -
   18.19 -
   18.20 -
   18.21 -subsubsection{*Embedding the Reals into the Hyperreals*}
   18.22 -
   18.23 -lemma hypreal_number_of [simp]: "hypreal_of_real (number_of w) = number_of w"
   18.24 -by (simp add: hypreal_number_of_def)
   18.25 +primrec (*the type constraint is essential!*)
   18.26 +  number_of_Pls: "number_of bin.Pls = 0"
   18.27 +  number_of_Min: "number_of bin.Min = - (1::hypreal)"
   18.28 +  number_of_BIT: "number_of(w BIT x) = (if x then 1 else 0) +
   18.29 +	                               (number_of w) + (number_of w)"
   18.30  
   18.31 -lemma hypreal_numeral_0_eq_0: "Numeral0 = (0::hypreal)"
   18.32 -by (simp add: hypreal_number_of_def)
   18.33 -
   18.34 -lemma hypreal_numeral_1_eq_1: "Numeral1 = (1::hypreal)"
   18.35 -by (simp add: hypreal_number_of_def)
   18.36 -
   18.37 -subsubsection{*Addition*}
   18.38 -
   18.39 -lemma add_hypreal_number_of [simp]:
   18.40 -     "(number_of v :: hypreal) + number_of v' = number_of (bin_add v v')"
   18.41 -by (simp only: hypreal_number_of_def hypreal_of_real_add [symmetric]
   18.42 -               add_real_number_of)
   18.43 -
   18.44 +declare number_of_Pls [simp del]
   18.45 +        number_of_Min [simp del]
   18.46 +        number_of_BIT [simp del]
   18.47  
   18.48 -subsubsection{*Subtraction*}
   18.49 -
   18.50 -lemma minus_hypreal_number_of [simp]:
   18.51 -     "- (number_of w :: hypreal) = number_of (bin_minus w)"
   18.52 -by (simp only: hypreal_number_of_def minus_real_number_of
   18.53 -               hypreal_of_real_minus [symmetric])
   18.54 -
   18.55 -lemma diff_hypreal_number_of [simp]:
   18.56 -     "(number_of v :: hypreal) - number_of w =
   18.57 -      number_of (bin_add v (bin_minus w))"
   18.58 -by (unfold hypreal_number_of_def hypreal_diff_def, simp)
   18.59 -
   18.60 -
   18.61 -subsubsection{*Multiplication*}
   18.62 -
   18.63 -lemma mult_hypreal_number_of [simp]:
   18.64 -     "(number_of v :: hypreal) * number_of v' = number_of (bin_mult v v')"
   18.65 -by (simp only: hypreal_number_of_def hypreal_of_real_mult [symmetric] mult_real_number_of)
   18.66 -
   18.67 -text{*Lemmas for specialist use, NOT as default simprules*}
   18.68 -lemma hypreal_mult_2: "2 * z = (z+z::hypreal)"
   18.69 -proof -
   18.70 -  have eq: "(2::hypreal) = 1 + 1"
   18.71 -    by (simp add: hypreal_numeral_1_eq_1 [symmetric])
   18.72 -  thus ?thesis by (simp add: eq left_distrib)
   18.73 +instance hypreal :: number_ring
   18.74 +proof
   18.75 +  show "Numeral0 = (0::hypreal)" by (rule number_of_Pls)
   18.76 +  show "-1 = - (1::hypreal)" by (rule number_of_Min)
   18.77 +  fix w :: bin and x :: bool
   18.78 +  show "(number_of (w BIT x) :: hypreal) =
   18.79 +        (if x then 1 else 0) + number_of w + number_of w"
   18.80 +    by (rule number_of_BIT)
   18.81  qed
   18.82  
   18.83 -lemma hypreal_mult_2_right: "z * 2 = (z+z::hypreal)"
   18.84 -by (subst hypreal_mult_commute, rule hypreal_mult_2)
   18.85 -
   18.86  
   18.87 -subsubsection{*Comparisons*}
   18.88 -
   18.89 -(** Equals (=) **)
   18.90 -
   18.91 -lemma eq_hypreal_number_of [simp]:
   18.92 -     "((number_of v :: hypreal) = number_of v') =
   18.93 -      iszero (number_of (bin_add v (bin_minus v')) :: int)"
   18.94 -apply (simp only: hypreal_number_of_def hypreal_of_real_eq_iff eq_real_number_of)
   18.95 +text{*Collapse applications of @{term hypreal_of_real} to @{term number_of}*}
   18.96 +lemma hypreal_number_of [simp]: "hypreal_of_real (number_of w) = number_of w"
   18.97 +apply (induct w) 
   18.98 +apply (simp_all only: number_of hypreal_of_real_add hypreal_of_real_minus, simp_all) 
   18.99  done
  18.100  
  18.101  
  18.102 -(** Less-than (<) **)
  18.103 -
  18.104 -(*"neg" is used in rewrite rules for binary comparisons*)
  18.105 -lemma less_hypreal_number_of [simp]:
  18.106 -     "((number_of v :: hypreal) < number_of v') =
  18.107 -      neg (number_of (bin_add v (bin_minus v')) :: int)"
  18.108 -by (simp only: hypreal_number_of_def hypreal_of_real_less_iff less_real_number_of)
  18.109 -
  18.110 -
  18.111 -
  18.112 -text{*New versions of existing theorems involving 0, 1*}
  18.113 -
  18.114 -lemma hypreal_minus_1_eq_m1 [simp]: "- 1 = (-1::hypreal)"
  18.115 -by (simp add: hypreal_numeral_1_eq_1 [symmetric])
  18.116 -
  18.117 -lemma hypreal_mult_minus1 [simp]: "-1 * z = -(z::hypreal)"
  18.118 -proof -
  18.119 -  have  "-1 * z = (- 1) * z" by (simp add: hypreal_minus_1_eq_m1)
  18.120 -  also have "... = - (1 * z)" by (simp only: minus_mult_left)
  18.121 -  also have "... = -z" by simp
  18.122 -  finally show ?thesis .
  18.123 -qed
  18.124 -
  18.125 -lemma hypreal_mult_minus1_right [simp]: "(z::hypreal) * -1 = -z"
  18.126 -by (subst hypreal_mult_commute, rule hypreal_mult_minus1)
  18.127 -
  18.128 -
  18.129 -subsection{*Simplification of Arithmetic when Nested to the Right*}
  18.130 -
  18.131 -lemma hypreal_add_number_of_left [simp]:
  18.132 -     "number_of v + (number_of w + z) = (number_of(bin_add v w) + z::hypreal)"
  18.133 -by (simp add: add_assoc [symmetric])
  18.134 -
  18.135 -lemma hypreal_mult_number_of_left [simp]:
  18.136 -     "number_of v *(number_of w * z) = (number_of(bin_mult v w) * z::hypreal)"
  18.137 -by (simp add: hypreal_mult_assoc [symmetric])
  18.138 -
  18.139 -lemma hypreal_add_number_of_diff1:
  18.140 -    "number_of v + (number_of w - c) = number_of(bin_add v w) - (c::hypreal)"
  18.141 -by (simp add: hypreal_diff_def hypreal_add_number_of_left)
  18.142 -
  18.143 -lemma hypreal_add_number_of_diff2 [simp]:
  18.144 -     "number_of v + (c - number_of w) =
  18.145 -      number_of (bin_add v (bin_minus w)) + (c::hypreal)"
  18.146 -apply (subst diff_hypreal_number_of [symmetric])
  18.147 -apply (simp only: hypreal_diff_def add_ac)
  18.148 -done
  18.149 -
  18.150 -
  18.151 -declare hypreal_numeral_0_eq_0 [simp] hypreal_numeral_1_eq_1 [simp]
  18.152 -
  18.153 -
  18.154 -
  18.155  use "hypreal_arith.ML"
  18.156  
  18.157  setup hypreal_arith_setup
  18.158 @@ -143,15 +50,6 @@
  18.159  by arith
  18.160  
  18.161  
  18.162 -subsubsection{*Division By @{term 1} and @{term "-1"}*}
  18.163 -
  18.164 -lemma hypreal_divide_minus1 [simp]: "x/-1 = -(x::hypreal)"
  18.165 -by simp
  18.166 -
  18.167 -lemma hypreal_minus1_divide [simp]: "-1/(x::hypreal) = - (1/x)"
  18.168 -by (simp add: hypreal_divide_def hypreal_minus_inverse)
  18.169 -
  18.170 -
  18.171  subsection{*The Function @{term hypreal_of_real}*}
  18.172  
  18.173  lemma number_of_less_hypreal_of_real_iff [simp]:
  18.174 @@ -161,7 +59,7 @@
  18.175  done
  18.176  
  18.177  lemma number_of_le_hypreal_of_real_iff [simp]:
  18.178 -     "(number_of w <= hypreal_of_real z) = (number_of w <= z)"
  18.179 +     "(number_of w \<le> hypreal_of_real z) = (number_of w \<le> z)"
  18.180  apply (subst hypreal_of_real_le_iff [symmetric])
  18.181  apply (simp (no_asm))
  18.182  done
  18.183 @@ -179,20 +77,13 @@
  18.184  done
  18.185  
  18.186  lemma hypreal_of_real_le_number_of_iff [simp]:
  18.187 -     "(hypreal_of_real z <= number_of w) = (z <= number_of w)"
  18.188 +     "(hypreal_of_real z \<le> number_of w) = (z \<le> number_of w)"
  18.189  apply (subst hypreal_of_real_le_iff [symmetric])
  18.190  apply (simp (no_asm))
  18.191  done
  18.192  
  18.193  subsection{*Absolute Value Function for the Hyperreals*}
  18.194  
  18.195 -lemma hrabs_number_of [simp]:
  18.196 -     "abs (number_of v :: hypreal) =
  18.197 -        (if neg (number_of v :: int) then number_of (bin_minus v)
  18.198 -         else number_of v)"
  18.199 -by (simp add: hrabs_def)
  18.200 -
  18.201 -
  18.202  declare abs_mult [simp]
  18.203  
  18.204  lemma hrabs_add_less: "[| abs x < r; abs y < s |] ==> abs(x+y) < r + (s::hypreal)"
  18.205 @@ -200,6 +91,7 @@
  18.206  apply (simp split add: split_if_asm)
  18.207  done
  18.208  
  18.209 +text{*used once in NSA*}
  18.210  lemma hrabs_less_gt_zero: "abs x < r ==> (0::hypreal) < r"
  18.211  by (blast intro!: order_le_less_trans abs_ge_zero)
  18.212  
  18.213 @@ -210,10 +102,6 @@
  18.214  lemma hrabs_add_lemma_disj: "(y::hypreal) + - x + (y + - z) = abs (x + - z) ==> y = z | x = y"
  18.215  by (simp add: hrabs_def split add: split_if_asm)
  18.216  
  18.217 -
  18.218 -(*----------------------------------------------------------
  18.219 -    Relating hrabs to abs through embedding of IR into IR*
  18.220 - ----------------------------------------------------------*)
  18.221  lemma hypreal_of_real_hrabs:
  18.222      "abs (hypreal_of_real r) = hypreal_of_real (abs r)"
  18.223  apply (unfold hypreal_of_real_def)
  18.224 @@ -301,9 +189,7 @@
  18.225  
  18.226  val hypreal_of_nat_def = thm"hypreal_of_nat_def";
  18.227  
  18.228 -val hrabs_number_of = thm "hrabs_number_of";
  18.229  val hrabs_add_less = thm "hrabs_add_less";
  18.230 -val hrabs_less_gt_zero = thm "hrabs_less_gt_zero";
  18.231  val hrabs_disj = thm "hrabs_disj";
  18.232  val hrabs_add_lemma_disj = thm "hrabs_add_lemma_disj";
  18.233  val hypreal_of_real_hrabs = thm "hypreal_of_real_hrabs";
    19.1 --- a/src/HOL/Hyperreal/HyperDef.thy	Sat Feb 14 02:06:12 2004 +0100
    19.2 +++ b/src/HOL/Hyperreal/HyperDef.thy	Sun Feb 15 10:46:37 2004 +0100
    19.3 @@ -504,8 +504,7 @@
    19.4        "(Abs_hypreal(hyprel``{%n. X n}) \<le> Abs_hypreal(hyprel``{%n. Y n})) =  
    19.5         ({n. X n \<le> Y n} \<in> FreeUltrafilterNat)"
    19.6  apply (unfold hypreal_le_def)
    19.7 -apply (auto intro!: lemma_hyprel_refl)
    19.8 -apply (ultra)
    19.9 +apply (auto intro!: lemma_hyprel_refl, ultra)
   19.10  done
   19.11  
   19.12  lemma hypreal_le_refl: "w \<le> (w::hypreal)"
   19.13 @@ -517,21 +516,18 @@
   19.14  apply (rule eq_Abs_hypreal [of i])
   19.15  apply (rule eq_Abs_hypreal [of j])
   19.16  apply (rule eq_Abs_hypreal [of k])
   19.17 -apply (simp add: hypreal_le) 
   19.18 -apply ultra
   19.19 +apply (simp add: hypreal_le, ultra)
   19.20  done
   19.21  
   19.22  lemma hypreal_le_anti_sym: "[| z \<le> w; w \<le> z |] ==> z = (w::hypreal)"
   19.23  apply (rule eq_Abs_hypreal [of z])
   19.24  apply (rule eq_Abs_hypreal [of w])
   19.25 -apply (simp add: hypreal_le) 
   19.26 -apply ultra
   19.27 +apply (simp add: hypreal_le, ultra)
   19.28  done
   19.29  
   19.30  (* Axiom 'order_less_le' of class 'order': *)
   19.31  lemma hypreal_less_le: "((w::hypreal) < z) = (w \<le> z & w \<noteq> z)"
   19.32 -apply (simp add: hypreal_less_def)
   19.33 -done
   19.34 +by (simp add: hypreal_less_def)
   19.35  
   19.36  instance hypreal :: order
   19.37  proof qed
   19.38 @@ -543,8 +539,7 @@
   19.39  lemma hypreal_le_linear: "(z::hypreal) \<le> w | w \<le> z"
   19.40  apply (rule eq_Abs_hypreal [of z])
   19.41  apply (rule eq_Abs_hypreal [of w])
   19.42 -apply (auto simp add: hypreal_le) 
   19.43 -apply ultra
   19.44 +apply (auto simp add: hypreal_le, ultra)
   19.45  done
   19.46  
   19.47  instance hypreal :: linorder 
   19.48 @@ -565,8 +560,7 @@
   19.49  apply (rule eq_Abs_hypreal [of y])
   19.50  apply (rule eq_Abs_hypreal [of z])
   19.51  apply (auto simp add: hypreal_zero_def hypreal_le hypreal_mult 
   19.52 -                      linorder_not_le [symmetric])
   19.53 -apply ultra 
   19.54 +                      linorder_not_le [symmetric], ultra) 
   19.55  done
   19.56  
   19.57  
   19.58 @@ -590,7 +584,7 @@
   19.59    by (rule Ring_and_Field.mult_1_right)
   19.60  
   19.61  lemma hypreal_mult_minus_1 [simp]: "(- (1::hypreal)) * z = -z"
   19.62 -by (simp)
   19.63 +by simp
   19.64  
   19.65  lemma hypreal_mult_minus_1_right [simp]: "z * (- (1::hypreal)) = -z"
   19.66  by (subst hypreal_mult_commute, simp)
   19.67 @@ -613,12 +607,10 @@
   19.68  by (auto dest: hypreal_eq_minus_iff [THEN iffD2])
   19.69  
   19.70  lemma hypreal_mult_left_cancel: "(c::hypreal) \<noteq> 0 ==> (c*a=c*b) = (a=b)"
   19.71 -apply auto
   19.72 -done
   19.73 +by auto
   19.74      
   19.75  lemma hypreal_mult_right_cancel: "(c::hypreal) \<noteq> 0 ==> (a*c=b*c) = (a=b)"
   19.76 -apply auto
   19.77 -done
   19.78 +by auto
   19.79  
   19.80  lemma hypreal_mult_not_0: "[| x \<noteq> 0; y \<noteq> 0 |] ==> x * y \<noteq> (0::hypreal)"
   19.81  by simp
   19.82 @@ -725,8 +717,7 @@
   19.83  lemma hypreal_less: 
   19.84        "(Abs_hypreal(hyprel``{%n. X n}) < Abs_hypreal(hyprel``{%n. Y n})) =  
   19.85         ({n. X n < Y n} \<in> FreeUltrafilterNat)"
   19.86 -apply (auto simp add: hypreal_le linorder_not_le [symmetric]) 
   19.87 -apply ultra+
   19.88 +apply (auto simp add: hypreal_le linorder_not_le [symmetric], ultra+)
   19.89  done
   19.90  
   19.91  lemma hypreal_zero_num: "0 = Abs_hypreal (hyprel `` {%n. 0})"
   19.92 @@ -773,7 +764,7 @@
   19.93  
   19.94  lemma lemma_omega_empty_singleton_disj: "{n::nat. x = real n} = {} |  
   19.95        (\<exists>y. {n::nat. x = real n} = {y})"
   19.96 -by (force)
   19.97 +by force
   19.98  
   19.99  lemma lemma_finite_omega_set: "finite {n::nat. x = real n}"
  19.100  by (cut_tac x = x in lemma_omega_empty_singleton_disj, auto)
  19.101 @@ -794,7 +785,7 @@
  19.102  lemma lemma_epsilon_empty_singleton_disj:
  19.103       "{n::nat. x = inverse(real(Suc n))} = {} |  
  19.104        (\<exists>y. {n::nat. x = inverse(real(Suc n))} = {y})"
  19.105 -by (auto)
  19.106 +by auto
  19.107  
  19.108  lemma lemma_finite_epsilon_set: "finite {n. x = inverse(real(Suc n))}"
  19.109  by (cut_tac x = x in lemma_epsilon_empty_singleton_disj, auto)
    20.1 --- a/src/HOL/Hyperreal/HyperPow.thy	Sat Feb 14 02:06:12 2004 +0100
    20.2 +++ b/src/HOL/Hyperreal/HyperPow.thy	Sun Feb 15 10:46:37 2004 +0100
    20.3 @@ -2,6 +2,7 @@
    20.4      Author      : Jacques D. Fleuriot  
    20.5      Copyright   : 1998  University of Cambridge
    20.6      Description : Powers theory for hyperreals
    20.7 +    Conversion to Isar and new proofs by Lawrence C Paulson, 2003/4
    20.8  *)
    20.9  
   20.10  header{*Exponentials on the Hyperreals*}
   20.11 @@ -123,7 +124,7 @@
   20.12  
   20.13  lemma power_hypreal_of_real_number_of:
   20.14       "(number_of v :: hypreal) ^ n = hypreal_of_real ((number_of v) ^ n)"
   20.15 -by (simp only: hypreal_number_of_def hypreal_of_real_power)
   20.16 +by (simp only: hypreal_number_of [symmetric] hypreal_of_real_power)
   20.17  
   20.18  declare power_hypreal_of_real_number_of [of _ "number_of w", standard, simp]
   20.19  
    21.1 --- a/src/HOL/Hyperreal/IntFloor.ML	Sat Feb 14 02:06:12 2004 +0100
    21.2 +++ b/src/HOL/Hyperreal/IntFloor.ML	Sun Feb 15 10:46:37 2004 +0100
    21.3 @@ -4,6 +4,8 @@
    21.4      Description: Floor and ceiling operations over reals
    21.5  *)
    21.6  
    21.7 +val real_number_of = thm"real_number_of";
    21.8 +
    21.9  Goal "((number_of n) < real (m::int)) = (number_of n < m)";
   21.10  by Auto_tac;
   21.11  by (rtac (real_of_int_less_iff RS iffD1) 1);
   21.12 @@ -187,8 +189,8 @@
   21.13  by (auto_tac (claset() addIs [floor_eq3],simpset()));
   21.14  qed "floor_eq4";
   21.15  
   21.16 -Goalw [real_number_of_def] 
   21.17 -       "floor(number_of n :: real) = (number_of n :: int)";
   21.18 +Goal "floor(number_of n :: real) = (number_of n :: int)";
   21.19 +by (stac (real_number_of RS sym) 1);
   21.20  by (rtac floor_eq2 1);
   21.21  by (rtac (CLAIM "x < x + (1::real)") 2);
   21.22  by (rtac real_le_refl 1);
   21.23 @@ -279,8 +281,9 @@
   21.24  by (auto_tac (claset() addIs [floor_eq2],simpset()));
   21.25  qed "ceiling_eq3";
   21.26  
   21.27 -Goalw [ceiling_def,real_number_of_def] 
   21.28 +Goalw [ceiling_def] 
   21.29    "ceiling (number_of n :: real) = (number_of n :: int)";
   21.30 +by (stac (real_number_of RS sym) 1);
   21.31  by (rtac (CLAIM "x = - y ==> - (x::int) = y") 1);
   21.32  by (rtac (floor_minus_real_of_int RS ssubst) 1);
   21.33  by Auto_tac;
    22.1 --- a/src/HOL/Hyperreal/Integration.ML	Sat Feb 14 02:06:12 2004 +0100
    22.2 +++ b/src/HOL/Hyperreal/Integration.ML	Sun Feb 15 10:46:37 2004 +0100
    22.3 @@ -4,6 +4,9 @@
    22.4      Description : Theory of integration (c.f. Harison's HOL development)
    22.5  *)
    22.6  
    22.7 +val mult_2 = thm"mult_2";
    22.8 +val mult_2_right = thm"mult_2_right";
    22.9 +
   22.10  Goalw [psize_def] "a = b ==> psize (%n. if n = 0 then a else b) = 0";
   22.11  by Auto_tac;
   22.12  qed "partition_zero";
   22.13 @@ -358,7 +361,7 @@
   22.14  by (dtac add_strict_mono 1 THEN assume_tac 1);
   22.15  by (auto_tac (claset(),
   22.16      HOL_ss addsimps [left_distrib RS sym,
   22.17 -                     real_mult_2_right RS sym, mult_less_cancel_right]));
   22.18 +                     mult_2_right RS sym, mult_less_cancel_right]));
   22.19  by (ALLGOALS(arith_tac));
   22.20  qed "Integral_unique";
   22.21  
   22.22 @@ -956,7 +959,7 @@
   22.23      ("c","abs (rsum (D, p) g - k2) * 2")] 
   22.24      add_strict_mono 1 THEN assume_tac 1);
   22.25  by (auto_tac (claset(),HOL_ss addsimps [rsum_add,left_distrib RS sym,
   22.26 -    real_mult_2_right RS sym,real_mult_less_iff1,CLAIM "(0::real) < 2"]));
   22.27 +    mult_2_right RS sym,real_mult_less_iff1,CLAIM "(0::real) < 2"]));
   22.28  by (arith_tac 1);
   22.29  qed "Integral_add_fun";
   22.30  
   22.31 @@ -1015,7 +1018,7 @@
   22.32  by (arith_tac 1);
   22.33  by (dtac add_strict_mono 1 THEN assume_tac 1);
   22.34  by (auto_tac (claset(),HOL_ss addsimps [left_distrib RS sym,
   22.35 -    real_mult_2_right RS sym,real_mult_less_iff1,CLAIM "(0::real) < 2"]));
   22.36 +    mult_2_right RS sym,real_mult_less_iff1,CLAIM "(0::real) < 2"]));
   22.37  by (arith_tac 1);
   22.38  qed "Integral_le";
   22.39  
   22.40 @@ -1037,7 +1040,7 @@
   22.41  by (thin_tac "0 < e" 1);
   22.42  by (dtac add_strict_mono 1 THEN assume_tac 1);
   22.43  by (auto_tac (claset(),HOL_ss addsimps [left_distrib RS sym,
   22.44 -    real_mult_2_right RS sym,real_mult_less_iff1,CLAIM "(0::real) < 2"]));
   22.45 +    mult_2_right RS sym,real_mult_less_iff1,CLAIM "(0::real) < 2"]));
   22.46  by (arith_tac 1);
   22.47  qed "Integral_imp_Cauchy";
   22.48  
    23.1 --- a/src/HOL/Hyperreal/Lim.ML	Sat Feb 14 02:06:12 2004 +0100
    23.2 +++ b/src/HOL/Hyperreal/Lim.ML	Sun Feb 15 10:46:37 2004 +0100
    23.3 @@ -1405,7 +1405,7 @@
    23.4  Goal "(\\<forall>z. f z - f x = g z * (z - x)) & isNSCont g x & g x = l \
    23.5  \     ==> NSDERIV f x :> l";
    23.6  by (auto_tac (claset(), 
    23.7 -              simpset() delsimprocs real_cancel_factor
    23.8 +              simpset() delsimprocs field_cancel_factor
    23.9                          addsimps [NSDERIV_iff2]));
   23.10  by (auto_tac (claset(),
   23.11                simpset() addsimps [hypreal_mult_assoc]));
   23.12 @@ -1877,9 +1877,25 @@
   23.13                addsplits [split_if_asm]) 1); 
   23.14  qed "DERIV_left_inc";
   23.15  
   23.16 -Goalw [deriv_def,LIM_def] 
   23.17 +val prems = goalw (the_context()) [deriv_def,LIM_def]
   23.18      "[| DERIV f x :> l;  l < 0 |] ==> \
   23.19  \      \\<exists>d. 0 < d & (\\<forall>h. 0 < h & h < d --> f(x) < f(x - h))";
   23.20 +by (cut_facts_tac prems 1);  (*needed because arith removes the assumption l<0*)
   23.21 +by (dres_inst_tac [("x","-l")] spec 1 THEN Auto_tac);
   23.22 +by (res_inst_tac [("x","s")] exI 1 THEN Auto_tac);
   23.23 +by (dres_inst_tac [("x","-h")] spec 1);
   23.24 +by (asm_full_simp_tac
   23.25 +    (simpset() addsimps [real_abs_def, inverse_eq_divide, 
   23.26 +                         pos_less_divide_eq,
   23.27 +                         symmetric real_diff_def]
   23.28 +               addsplits [split_if_asm]) 1);
   23.29 +by (subgoal_tac "0 < (f (x - h) - f x)/h" 1);
   23.30 +by (asm_full_simp_tac (simpset() addsimps [pos_less_divide_eq]) 1); 
   23.31 +by (cut_facts_tac prems 1);
   23.32 +by (arith_tac 1);
   23.33 +qed "DERIV_left_dec";
   23.34 +
   23.35 +(*????previous proof, revealing arith problem:
   23.36  by (dres_inst_tac [("x","-l")] spec 1 THEN Auto_tac);
   23.37  by (res_inst_tac [("x","s")] exI 1 THEN Auto_tac);
   23.38  by (subgoal_tac "l*h < 0" 1);
   23.39 @@ -1896,6 +1912,7 @@
   23.40  by (asm_full_simp_tac
   23.41      (simpset() addsimps [pos_less_divide_eq]) 1); 
   23.42  qed "DERIV_left_dec";
   23.43 +*)
   23.44  
   23.45  
   23.46  Goal "[| DERIV f x :> l; \
    24.1 --- a/src/HOL/Hyperreal/Lim.thy	Sat Feb 14 02:06:12 2004 +0100
    24.2 +++ b/src/HOL/Hyperreal/Lim.thy	Sun Feb 15 10:46:37 2004 +0100
    24.3 @@ -5,7 +5,7 @@
    24.4                    differentiation of real=>real functions
    24.5  *)
    24.6  
    24.7 -Lim = SEQ + RealArith + 
    24.8 +Lim = SEQ + RealDef + 
    24.9  
   24.10  (*-----------------------------------------------------------------------
   24.11      Limits, continuity and differentiation: standard and NS definitions
    25.1 --- a/src/HOL/Hyperreal/NSA.thy	Sat Feb 14 02:06:12 2004 +0100
    25.2 +++ b/src/HOL/Hyperreal/NSA.thy	Sun Feb 15 10:46:37 2004 +0100
    25.3 @@ -95,7 +95,7 @@
    25.4  declare SReal_hypreal_of_real [simp]
    25.5  
    25.6  lemma SReal_number_of: "(number_of w ::hypreal) \<in> Reals"
    25.7 -apply (unfold hypreal_number_of_def)
    25.8 +apply (simp only: hypreal_number_of [symmetric])
    25.9  apply (rule SReal_hypreal_of_real)
   25.10  done
   25.11  declare SReal_number_of [simp]
   25.12 @@ -103,13 +103,13 @@
   25.13  (** As always with numerals, 0 and 1 are special cases **)
   25.14  
   25.15  lemma Reals_0: "(0::hypreal) \<in> Reals"
   25.16 -apply (subst hypreal_numeral_0_eq_0 [symmetric])
   25.17 +apply (subst numeral_0_eq_0 [symmetric])
   25.18  apply (rule SReal_number_of)
   25.19  done
   25.20  declare Reals_0 [simp]
   25.21  
   25.22  lemma Reals_1: "(1::hypreal) \<in> Reals"
   25.23 -apply (subst hypreal_numeral_1_eq_1 [symmetric])
   25.24 +apply (subst numeral_1_eq_1 [symmetric])
   25.25  apply (rule SReal_number_of)
   25.26  done
   25.27  declare Reals_1 [simp]
   25.28 @@ -267,13 +267,13 @@
   25.29  (** As always with numerals, 0 and 1 are special cases **)
   25.30  
   25.31  lemma HFinite_0: "0 \<in> HFinite"
   25.32 -apply (subst hypreal_numeral_0_eq_0 [symmetric])
   25.33 +apply (subst numeral_0_eq_0 [symmetric])
   25.34  apply (rule HFinite_number_of)
   25.35  done
   25.36  declare HFinite_0 [simp]
   25.37  
   25.38  lemma HFinite_1: "1 \<in> HFinite"
   25.39 -apply (subst hypreal_numeral_1_eq_1 [symmetric])
   25.40 +apply (subst numeral_1_eq_1 [symmetric])
   25.41  apply (rule HFinite_number_of)
   25.42  done
   25.43  declare HFinite_1 [simp]
   25.44 @@ -859,7 +859,7 @@
   25.45  
   25.46  (*again: 1 is a special case, but not 0 this time*)
   25.47  lemma one_not_Infinitesimal: "1 \<notin> Infinitesimal"
   25.48 -apply (subst hypreal_numeral_1_eq_1 [symmetric])
   25.49 +apply (subst numeral_1_eq_1 [symmetric])
   25.50  apply (rule number_of_not_Infinitesimal)
   25.51  apply (simp (no_asm))
   25.52  done
   25.53 @@ -1424,12 +1424,14 @@
   25.54       "[| x < y;  u \<in> Infinitesimal |]
   25.55        ==> hypreal_of_real x + u < hypreal_of_real y"
   25.56  apply (simp add: Infinitesimal_def)
   25.57 -apply (drule hypreal_of_real_less_iff [THEN iffD2])
   25.58  apply (drule_tac x = "hypreal_of_real y + -hypreal_of_real x" in bspec)
   25.59 -apply (auto simp add: hypreal_add_commute abs_less_iff SReal_add SReal_minus)
   25.60 + apply (simp add: );  
   25.61 +apply (auto simp add: add_commute abs_less_iff SReal_add SReal_minus)
   25.62 +apply (simp add: compare_rls) 
   25.63  done
   25.64  
   25.65 -lemma Infinitesimal_add_hrabs_hypreal_of_real_less: "[| x \<in> Infinitesimal; abs(hypreal_of_real r) < hypreal_of_real y |]
   25.66 +lemma Infinitesimal_add_hrabs_hypreal_of_real_less:
   25.67 +     "[| x \<in> Infinitesimal; abs(hypreal_of_real r) < hypreal_of_real y |]
   25.68        ==> abs (hypreal_of_real r + x) < hypreal_of_real y"
   25.69  apply (drule_tac x = "hypreal_of_real r" in approx_hrabs_add_Infinitesimal)
   25.70  apply (drule approx_sym [THEN bex_Infinitesimal_iff2 [THEN iffD2]])
   25.71 @@ -1692,7 +1694,7 @@
   25.72  done
   25.73  
   25.74  lemma st_Infinitesimal: "x \<in> Infinitesimal ==> st x = 0"
   25.75 -apply (subst hypreal_numeral_0_eq_0 [symmetric])
   25.76 +apply (subst numeral_0_eq_0 [symmetric])
   25.77  apply (rule st_number_of [THEN subst])
   25.78  apply (rule approx_st_eq)
   25.79  apply (auto intro: Infinitesimal_subset_HFinite [THEN subsetD] simp add: mem_infmal_iff [symmetric])
   25.80 @@ -1743,13 +1745,13 @@
   25.81  done
   25.82  
   25.83  lemma st_zero_le: "[| 0 <= x;  x \<in> HFinite |] ==> 0 <= st x"
   25.84 -apply (subst hypreal_numeral_0_eq_0 [symmetric])
   25.85 +apply (subst numeral_0_eq_0 [symmetric])
   25.86  apply (rule st_number_of [THEN subst])
   25.87  apply (rule st_le, auto)
   25.88  done
   25.89  
   25.90  lemma st_zero_ge: "[| x <= 0;  x \<in> HFinite |] ==> st x <= 0"
   25.91 -apply (subst hypreal_numeral_0_eq_0 [symmetric])
   25.92 +apply (subst numeral_0_eq_0 [symmetric])
   25.93  apply (rule st_number_of [THEN subst])
   25.94  apply (rule st_le, auto)
   25.95  done
    26.1 --- a/src/HOL/Hyperreal/SEQ.ML	Sat Feb 14 02:06:12 2004 +0100
    26.2 +++ b/src/HOL/Hyperreal/SEQ.ML	Sun Feb 15 10:46:37 2004 +0100
    26.3 @@ -398,6 +398,7 @@
    26.4  Goal "(EX K. 0 < K & (ALL n. abs(X n) <= K)) = \
    26.5  \     (EX N. ALL n. abs(X n) <= real(Suc N))";
    26.6  by Auto_tac;
    26.7 +by (Force_tac 2);
    26.8  by (cut_inst_tac [("x","K")] reals_Archimedean2 1);
    26.9  by (Clarify_tac 1); 
   26.10  by (res_inst_tac [("x","n")] exI 1); 
    27.1 --- a/src/HOL/Hyperreal/Transcendental.ML	Sat Feb 14 02:06:12 2004 +0100
    27.2 +++ b/src/HOL/Hyperreal/Transcendental.ML	Sun Feb 15 10:46:37 2004 +0100
    27.3 @@ -75,8 +75,8 @@
    27.4  
    27.5  (*lcp: needed now because 2 is a binary numeral!*)
    27.6  Goal "root 2 = root (Suc (Suc 0))";
    27.7 -by (simp_tac (simpset() delsimps [numeral_0_eq_0, numeral_1_eq_1]
    27.8 -	                addsimps [numeral_0_eq_0 RS sym]) 1);  
    27.9 +by (simp_tac (simpset() delsimps [nat_numeral_0_eq_0, nat_numeral_1_eq_1]
   27.10 +	                addsimps [nat_numeral_0_eq_0 RS sym]) 1);  
   27.11  qed "root_2_eq";
   27.12  Addsimps [root_2_eq];
   27.13  
   27.14 @@ -2077,7 +2077,7 @@
   27.15  Goal "[| cos x ~= 0; cos (2 * x) ~= 0 |] \
   27.16  \     ==> tan (2 * x) = (2 * tan x)/(1 - (tan(x) ^ 2))";
   27.17  by (auto_tac (claset(),simpset() addsimps [asm_full_simplify 
   27.18 -    (simpset() addsimps [real_mult_2 RS sym] delsimps [lemma_tan_add1]) 
   27.19 +    (simpset() addsimps [thm"mult_2" RS sym] delsimps [lemma_tan_add1]) 
   27.20      (read_instantiate [("x","x"),("y","x")] tan_add),numeral_2_eq_2]
   27.21      delsimps [lemma_tan_add1]));
   27.22  qed "tan_double";
    28.1 --- a/src/HOL/Hyperreal/hypreal_arith.ML	Sat Feb 14 02:06:12 2004 +0100
    28.2 +++ b/src/HOL/Hyperreal/hypreal_arith.ML	Sun Feb 15 10:46:37 2004 +0100
    28.3 @@ -15,506 +15,11 @@
    28.4      read_instantiate_sg(sign_of (the_context())) [("a","?a::hypreal")] mult_left_mono;
    28.5  
    28.6  
    28.7 -val hypreal_number_of = thm "hypreal_number_of";
    28.8 -val hypreal_numeral_0_eq_0 = thm "hypreal_numeral_0_eq_0";
    28.9 -val hypreal_numeral_1_eq_1 = thm "hypreal_numeral_1_eq_1";
   28.10 -val hypreal_number_of_def = thm "hypreal_number_of_def";
   28.11 -val add_hypreal_number_of = thm "add_hypreal_number_of";
   28.12 -val minus_hypreal_number_of = thm "minus_hypreal_number_of";
   28.13 -val diff_hypreal_number_of = thm "diff_hypreal_number_of";
   28.14 -val mult_hypreal_number_of = thm "mult_hypreal_number_of";
   28.15 -val hypreal_mult_2 = thm "hypreal_mult_2";
   28.16 -val hypreal_mult_2_right = thm "hypreal_mult_2_right";
   28.17 -val eq_hypreal_number_of = thm "eq_hypreal_number_of";
   28.18 -val less_hypreal_number_of = thm "less_hypreal_number_of";
   28.19 -val hypreal_minus_1_eq_m1 = thm "hypreal_minus_1_eq_m1";
   28.20 -val hypreal_mult_minus1 = thm "hypreal_mult_minus1";
   28.21 -val hypreal_mult_minus1_right = thm "hypreal_mult_minus1_right";
   28.22 -val hypreal_add_number_of_left = thm "hypreal_add_number_of_left";
   28.23 -val hypreal_mult_number_of_left = thm "hypreal_mult_number_of_left";
   28.24 -val hypreal_add_number_of_diff1 = thm "hypreal_add_number_of_diff1";
   28.25 -val hypreal_add_number_of_diff2 = thm "hypreal_add_number_of_diff2";
   28.26 -
   28.27 -(*Maps 0 to Numeral0 and 1 to Numeral1 and -(Numeral1) to -1*)
   28.28 -val hypreal_numeral_ss =
   28.29 -    real_numeral_ss addsimps [hypreal_numeral_0_eq_0 RS sym,
   28.30 -                              hypreal_numeral_1_eq_1 RS sym,
   28.31 -                              hypreal_minus_1_eq_m1]
   28.32 -
   28.33 -fun rename_numerals th =
   28.34 -    asm_full_simplify hypreal_numeral_ss (Thm.transfer (the_context ()) th)
   28.35 -
   28.36 -
   28.37 -structure Hyperreal_Numeral_Simprocs =
   28.38 -struct
   28.39 -
   28.40 -(*Maps 0 to Numeral0 and 1 to Numeral1 so that arithmetic in simprocs
   28.41 -  isn't complicated by the abstract 0 and 1.*)
   28.42 -val numeral_syms = [hypreal_numeral_0_eq_0 RS sym,
   28.43 -                    hypreal_numeral_1_eq_1 RS sym]
   28.44 -
   28.45 -(*Utilities*)
   28.46 -
   28.47 -val hyprealT = Type("HyperDef.hypreal",[])
   28.48 -
   28.49 -fun mk_numeral n = HOLogic.number_of_const hyprealT $ HOLogic.mk_bin n
   28.50 -
   28.51 -val dest_numeral = Real_Numeral_Simprocs.dest_numeral
   28.52 -
   28.53 -val find_first_numeral = Real_Numeral_Simprocs.find_first_numeral
   28.54 -
   28.55 -val zero = mk_numeral 0
   28.56 -val mk_plus = Real_Numeral_Simprocs.mk_plus
   28.57 -
   28.58 -val uminus_const = Const ("uminus", hyprealT --> hyprealT)
   28.59 -
   28.60 -(*Thus mk_sum[t] yields t+0; longer sums don't have a trailing zero*)
   28.61 -fun mk_sum []        = zero
   28.62 -  | mk_sum [t,u]     = mk_plus (t, u)
   28.63 -  | mk_sum (t :: ts) = mk_plus (t, mk_sum ts)
   28.64 -
   28.65 -(*this version ALWAYS includes a trailing zero*)
   28.66 -fun long_mk_sum []        = zero
   28.67 -  | long_mk_sum (t :: ts) = mk_plus (t, mk_sum ts)
   28.68 -
   28.69 -val dest_plus = HOLogic.dest_bin "op +" hyprealT
   28.70 -
   28.71 -(*decompose additions AND subtractions as a sum*)
   28.72 -fun dest_summing (pos, Const ("op +", _) $ t $ u, ts) =
   28.73 -        dest_summing (pos, t, dest_summing (pos, u, ts))
   28.74 -  | dest_summing (pos, Const ("op -", _) $ t $ u, ts) =
   28.75 -        dest_summing (pos, t, dest_summing (not pos, u, ts))
   28.76 -  | dest_summing (pos, t, ts) =
   28.77 -        if pos then t::ts else uminus_const$t :: ts
   28.78 -
   28.79 -fun dest_sum t = dest_summing (true, t, [])
   28.80 -
   28.81 -val mk_diff = HOLogic.mk_binop "op -"
   28.82 -val dest_diff = HOLogic.dest_bin "op -" hyprealT
   28.83 -
   28.84 -val one = mk_numeral 1
   28.85 -val mk_times = HOLogic.mk_binop "op *"
   28.86 -
   28.87 -fun mk_prod [] = one
   28.88 -  | mk_prod [t] = t
   28.89 -  | mk_prod (t :: ts) = if t = one then mk_prod ts
   28.90 -                        else mk_times (t, mk_prod ts)
   28.91 -
   28.92 -val dest_times = HOLogic.dest_bin "op *" hyprealT
   28.93 -
   28.94 -fun dest_prod t =
   28.95 -      let val (t,u) = dest_times t
   28.96 -      in  dest_prod t @ dest_prod u  end
   28.97 -      handle TERM _ => [t]
   28.98 -
   28.99 -(*DON'T do the obvious simplifications; that would create special cases*)
  28.100 -fun mk_coeff (k, ts) = mk_times (mk_numeral k, ts)
  28.101 -
  28.102 -(*Express t as a product of (possibly) a numeral with other sorted terms*)
  28.103 -fun dest_coeff sign (Const ("uminus", _) $ t) = dest_coeff (~sign) t
  28.104 -  | dest_coeff sign t =
  28.105 -    let val ts = sort Term.term_ord (dest_prod t)
  28.106 -        val (n, ts') = find_first_numeral [] ts
  28.107 -                          handle TERM _ => (1, ts)
  28.108 -    in (sign*n, mk_prod ts') end
  28.109 -
  28.110 -(*Find first coefficient-term THAT MATCHES u*)
  28.111 -fun find_first_coeff past u [] = raise TERM("find_first_coeff", [])
  28.112 -  | find_first_coeff past u (t::terms) =
  28.113 -        let val (n,u') = dest_coeff 1 t
  28.114 -        in  if u aconv u' then (n, rev past @ terms)
  28.115 -                          else find_first_coeff (t::past) u terms
  28.116 -        end
  28.117 -        handle TERM _ => find_first_coeff (t::past) u terms
  28.118 -
  28.119 -
  28.120 -(*Simplify Numeral0+n, n+Numeral0, Numeral1*n, n*Numeral1*)
  28.121 -val add_0s = map rename_numerals
  28.122 -                 [hypreal_add_zero_left, hypreal_add_zero_right]
  28.123 -val mult_1s = map rename_numerals [hypreal_mult_1, hypreal_mult_1_right] @
  28.124 -              [hypreal_mult_minus1, hypreal_mult_minus1_right]
  28.125 -
  28.126 -(*To perform binary arithmetic*)
  28.127 -val bin_simps =
  28.128 -    [hypreal_numeral_0_eq_0 RS sym, hypreal_numeral_1_eq_1 RS sym,
  28.129 -     add_hypreal_number_of, hypreal_add_number_of_left,
  28.130 -     minus_hypreal_number_of,
  28.131 -     diff_hypreal_number_of, mult_hypreal_number_of,
  28.132 -     hypreal_mult_number_of_left] @ bin_arith_simps @ bin_rel_simps
  28.133 -
  28.134 -(*Binary arithmetic BUT NOT ADDITION since it may collapse adjacent terms
  28.135 -  during re-arrangement*)
  28.136 -val non_add_bin_simps = 
  28.137 -    bin_simps \\ [hypreal_add_number_of_left, add_hypreal_number_of]
  28.138 -
  28.139 -(*To evaluate binary negations of coefficients*)
  28.140 -val hypreal_minus_simps = NCons_simps @
  28.141 -                   [hypreal_minus_1_eq_m1, minus_hypreal_number_of,
  28.142 -                    bin_minus_1, bin_minus_0, bin_minus_Pls, bin_minus_Min,
  28.143 -                    bin_pred_1, bin_pred_0, bin_pred_Pls, bin_pred_Min]
  28.144 -
  28.145 -(*To let us treat subtraction as addition*)
  28.146 -val diff_simps = [hypreal_diff_def, minus_add_distrib, minus_minus]
  28.147 -
  28.148 -(*push the unary minus down: - x * y = x * - y *)
  28.149 -val hypreal_minus_mult_eq_1_to_2 =
  28.150 -    [minus_mult_left RS sym, minus_mult_right] MRS trans
  28.151 -    |> standard
  28.152 -
  28.153 -(*to extract again any uncancelled minuses*)
  28.154 -val hypreal_minus_from_mult_simps =
  28.155 -    [minus_minus, minus_mult_left RS sym, minus_mult_right RS sym]
  28.156 -
  28.157 -(*combine unary minus with numeric literals, however nested within a product*)
  28.158 -val hypreal_mult_minus_simps =
  28.159 -    [hypreal_mult_assoc, minus_mult_left, hypreal_minus_mult_eq_1_to_2]
  28.160 -
  28.161 -(*Final simplification: cancel + and *  *)
  28.162 -val simplify_meta_eq =
  28.163 -    Int_Numeral_Simprocs.simplify_meta_eq
  28.164 -         [hypreal_add_zero_left, hypreal_add_zero_right,
  28.165 -          mult_zero_left, mult_zero_right, mult_1, mult_1_right]
  28.166 -
  28.167 -val prep_simproc = Real_Numeral_Simprocs.prep_simproc
  28.168 -
  28.169 -structure CancelNumeralsCommon =
  28.170 -  struct
  28.171 -  val mk_sum            = mk_sum
  28.172 -  val dest_sum          = dest_sum
  28.173 -  val mk_coeff          = mk_coeff
  28.174 -  val dest_coeff        = dest_coeff 1
  28.175 -  val find_first_coeff  = find_first_coeff []
  28.176 -  val trans_tac         = Real_Numeral_Simprocs.trans_tac
  28.177 -  val norm_tac =
  28.178 -     ALLGOALS (simp_tac (HOL_ss addsimps add_0s@mult_1s@diff_simps@
  28.179 -                                         hypreal_minus_simps@add_ac))
  28.180 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps non_add_bin_simps@hypreal_mult_minus_simps))
  28.181 -     THEN ALLGOALS
  28.182 -              (simp_tac (HOL_ss addsimps hypreal_minus_from_mult_simps@
  28.183 -                                         add_ac@mult_ac))
  28.184 -  val numeral_simp_tac  = ALLGOALS (simp_tac (HOL_ss addsimps add_0s@bin_simps))
  28.185 -  val simplify_meta_eq  = simplify_meta_eq
  28.186 -  end
  28.187 -
  28.188 -
  28.189 -structure EqCancelNumerals = CancelNumeralsFun
  28.190 - (open CancelNumeralsCommon
  28.191 -  val prove_conv = Bin_Simprocs.prove_conv
  28.192 -  val mk_bal   = HOLogic.mk_eq
  28.193 -  val dest_bal = HOLogic.dest_bin "op =" hyprealT
  28.194 -  val bal_add1 = eq_add_iff1 RS trans
  28.195 -  val bal_add2 = eq_add_iff2 RS trans
  28.196 -)
  28.197 -
  28.198 -structure LessCancelNumerals = CancelNumeralsFun
  28.199 - (open CancelNumeralsCommon
  28.200 -  val prove_conv = Bin_Simprocs.prove_conv
  28.201 -  val mk_bal   = HOLogic.mk_binrel "op <"
  28.202 -  val dest_bal = HOLogic.dest_bin "op <" hyprealT
  28.203 -  val bal_add1 = less_add_iff1 RS trans
  28.204 -  val bal_add2 = less_add_iff2 RS trans
  28.205 -)
  28.206 -
  28.207 -structure LeCancelNumerals = CancelNumeralsFun
  28.208 - (open CancelNumeralsCommon
  28.209 -  val prove_conv = Bin_Simprocs.prove_conv
  28.210 -  val mk_bal   = HOLogic.mk_binrel "op <="
  28.211 -  val dest_bal = HOLogic.dest_bin "op <=" hyprealT
  28.212 -  val bal_add1 = le_add_iff1 RS trans
  28.213 -  val bal_add2 = le_add_iff2 RS trans
  28.214 -)
  28.215 -
  28.216 -val cancel_numerals =
  28.217 -  map prep_simproc
  28.218 -   [("hyprealeq_cancel_numerals",
  28.219 -     ["(l::hypreal) + m = n", "(l::hypreal) = m + n",
  28.220 -      "(l::hypreal) - m = n", "(l::hypreal) = m - n",
  28.221 -      "(l::hypreal) * m = n", "(l::hypreal) = m * n"],
  28.222 -     EqCancelNumerals.proc),
  28.223 -    ("hyprealless_cancel_numerals",
  28.224 -     ["(l::hypreal) + m < n", "(l::hypreal) < m + n",
  28.225 -      "(l::hypreal) - m < n", "(l::hypreal) < m - n",
  28.226 -      "(l::hypreal) * m < n", "(l::hypreal) < m * n"],
  28.227 -     LessCancelNumerals.proc),
  28.228 -    ("hyprealle_cancel_numerals",
  28.229 -     ["(l::hypreal) + m <= n", "(l::hypreal) <= m + n",
  28.230 -      "(l::hypreal) - m <= n", "(l::hypreal) <= m - n",
  28.231 -      "(l::hypreal) * m <= n", "(l::hypreal) <= m * n"],
  28.232 -     LeCancelNumerals.proc)]
  28.233 -
  28.234 -
  28.235 -structure CombineNumeralsData =
  28.236 -  struct
  28.237 -  val add               = op + : int*int -> int
  28.238 -  val mk_sum            = long_mk_sum    (*to work for e.g. 2*x + 3*x *)
  28.239 -  val dest_sum          = dest_sum
  28.240 -  val mk_coeff          = mk_coeff
  28.241 -  val dest_coeff        = dest_coeff 1
  28.242 -  val left_distrib      = combine_common_factor RS trans
  28.243 -  val prove_conv        = Bin_Simprocs.prove_conv_nohyps
  28.244 -  val trans_tac         = Real_Numeral_Simprocs.trans_tac
  28.245 -  val norm_tac =
  28.246 -     ALLGOALS (simp_tac (HOL_ss addsimps numeral_syms@add_0s@mult_1s@
  28.247 -                                   diff_simps@hypreal_minus_simps@add_ac))
  28.248 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps non_add_bin_simps@hypreal_mult_minus_simps))
  28.249 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps hypreal_minus_from_mult_simps@
  28.250 -                                              add_ac@mult_ac))
  28.251 -  val numeral_simp_tac  = ALLGOALS
  28.252 -                    (simp_tac (HOL_ss addsimps add_0s@bin_simps))
  28.253 -  val simplify_meta_eq  = simplify_meta_eq
  28.254 -  end
  28.255 -
  28.256 -structure CombineNumerals = CombineNumeralsFun(CombineNumeralsData)
  28.257 -
  28.258 -val combine_numerals =
  28.259 -  prep_simproc
  28.260 -    ("hypreal_combine_numerals", ["(i::hypreal) + j", "(i::hypreal) - j"], CombineNumerals.proc)
  28.261 -
  28.262 -
  28.263 -(** Declarations for ExtractCommonTerm **)
  28.264 -
  28.265 -(*this version ALWAYS includes a trailing one*)
  28.266 -fun long_mk_prod []        = one
  28.267 -  | long_mk_prod (t :: ts) = mk_times (t, mk_prod ts)
  28.268 -
  28.269 -(*Find first term that matches u*)
  28.270 -fun find_first past u []         = raise TERM("find_first", [])
  28.271 -  | find_first past u (t::terms) =
  28.272 -        if u aconv t then (rev past @ terms)
  28.273 -        else find_first (t::past) u terms
  28.274 -        handle TERM _ => find_first (t::past) u terms
  28.275 -
  28.276 -(*Final simplification: cancel + and *  *)
  28.277 -fun cancel_simplify_meta_eq cancel_th th =
  28.278 -    Int_Numeral_Simprocs.simplify_meta_eq
  28.279 -        [mult_1, mult_1_right]
  28.280 -        (([th, cancel_th]) MRS trans)
  28.281 -
  28.282 -(*** Making constant folding work for 0 and 1 too ***)
  28.283 -
  28.284 -structure HyperrealAbstractNumeralsData =
  28.285 -  struct
  28.286 -  val dest_eq         = HOLogic.dest_eq o HOLogic.dest_Trueprop o concl_of
  28.287 -  val is_numeral      = Bin_Simprocs.is_numeral
  28.288 -  val numeral_0_eq_0  = hypreal_numeral_0_eq_0
  28.289 -  val numeral_1_eq_1  = hypreal_numeral_1_eq_1
  28.290 -  val prove_conv      = Bin_Simprocs.prove_conv_nohyps_novars
  28.291 -  fun norm_tac simps  = ALLGOALS (simp_tac (HOL_ss addsimps simps))
  28.292 -  val simplify_meta_eq = Bin_Simprocs.simplify_meta_eq
  28.293 -  end
  28.294 -
  28.295 -structure HyperrealAbstractNumerals =
  28.296 -  AbstractNumeralsFun (HyperrealAbstractNumeralsData)
  28.297 -
  28.298 -(*For addition, we already have rules for the operand 0.
  28.299 -  Multiplication is omitted because there are already special rules for
  28.300 -  both 0 and 1 as operands.  Unary minus is trivial, just have - 1 = -1.
  28.301 -  For the others, having three patterns is a compromise between just having
  28.302 -  one (many spurious calls) and having nine (just too many!) *)
  28.303 -val eval_numerals =
  28.304 -  map prep_simproc
  28.305 -   [("hypreal_add_eval_numerals",
  28.306 -     ["(m::hypreal) + 1", "(m::hypreal) + number_of v"],
  28.307 -     HyperrealAbstractNumerals.proc add_hypreal_number_of),
  28.308 -    ("hypreal_diff_eval_numerals",
  28.309 -     ["(m::hypreal) - 1", "(m::hypreal) - number_of v"],
  28.310 -     HyperrealAbstractNumerals.proc diff_hypreal_number_of),
  28.311 -    ("hypreal_eq_eval_numerals",
  28.312 -     ["(m::hypreal) = 0", "(m::hypreal) = 1", "(m::hypreal) = number_of v"],
  28.313 -     HyperrealAbstractNumerals.proc eq_hypreal_number_of),
  28.314 -    ("hypreal_less_eval_numerals",
  28.315 -     ["(m::hypreal) < 0", "(m::hypreal) < 1", "(m::hypreal) < number_of v"],
  28.316 -     HyperrealAbstractNumerals.proc less_hypreal_number_of),
  28.317 -    ("hypreal_le_eval_numerals",
  28.318 -     ["(m::hypreal) <= 0", "(m::hypreal) <= 1", "(m::hypreal) <= number_of v"],
  28.319 -     HyperrealAbstractNumerals.proc le_number_of_eq_not_less)]
  28.320 -
  28.321 -end;
  28.322 -
  28.323 -Addsimprocs Hyperreal_Numeral_Simprocs.eval_numerals;
  28.324 -Addsimprocs Hyperreal_Numeral_Simprocs.cancel_numerals;
  28.325 -Addsimprocs [Hyperreal_Numeral_Simprocs.combine_numerals];
  28.326 -
  28.327 -
  28.328 -
  28.329 -
  28.330 -(**** Constant folding for hypreal plus and times ****)
  28.331 -
  28.332 -(*We do not need
  28.333 -    structure Hyperreal_Plus_Assoc = Assoc_Fold (Hyperreal_Plus_Assoc_Data)
  28.334 -  because combine_numerals does the same thing*)
  28.335 -
  28.336 -structure Hyperreal_Times_Assoc_Data : ASSOC_FOLD_DATA =
  28.337 -struct
  28.338 -  val ss                = HOL_ss
  28.339 -  val eq_reflection     = eq_reflection
  28.340 -  val sg_ref    = Sign.self_ref (Theory.sign_of (the_context ()))
  28.341 -  val T      = Hyperreal_Numeral_Simprocs.hyprealT
  28.342 -  val plus   = Const ("op *", [T,T] ---> T)
  28.343 -  val add_ac = mult_ac
  28.344 -end;
  28.345 -
  28.346 -structure Hyperreal_Times_Assoc = Assoc_Fold (Hyperreal_Times_Assoc_Data);
  28.347 -
  28.348 -Addsimprocs [Hyperreal_Times_Assoc.conv];
  28.349 -
  28.350 -
  28.351 -
  28.352 -(**** Simprocs for numeric literals ****)
  28.353 -
  28.354 -
  28.355 -(****Common factor cancellation****)
  28.356 -
  28.357 -local
  28.358 -  open Hyperreal_Numeral_Simprocs
  28.359 -in
  28.360 -
  28.361 -val rel_hypreal_number_of = [eq_hypreal_number_of, less_hypreal_number_of,
  28.362 -                             le_number_of_eq_not_less];
  28.363 -
  28.364 -structure CancelNumeralFactorCommon =
  28.365 -  struct
  28.366 -  val mk_coeff          = mk_coeff
  28.367 -  val dest_coeff        = dest_coeff 1
  28.368 -  val trans_tac         = Real_Numeral_Simprocs.trans_tac
  28.369 -  val norm_tac =
  28.370 -     ALLGOALS (simp_tac (HOL_ss addsimps hypreal_minus_from_mult_simps @ mult_1s))
  28.371 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps bin_simps@hypreal_mult_minus_simps))
  28.372 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps mult_ac))
  28.373 -  val numeral_simp_tac  =
  28.374 -         ALLGOALS (simp_tac (HOL_ss addsimps rel_hypreal_number_of@bin_simps))
  28.375 -  val simplify_meta_eq  = simplify_meta_eq
  28.376 -  end
  28.377 -
  28.378 -structure DivCancelNumeralFactor = CancelNumeralFactorFun
  28.379 - (open CancelNumeralFactorCommon
  28.380 -  val prove_conv = Bin_Simprocs.prove_conv
  28.381 -  val mk_bal   = HOLogic.mk_binop "HOL.divide"
  28.382 -  val dest_bal = HOLogic.dest_bin "HOL.divide" hyprealT
  28.383 -  val cancel = mult_divide_cancel_left RS trans
  28.384 -  val neg_exchanges = false
  28.385 -)
  28.386 -
  28.387 -structure EqCancelNumeralFactor = CancelNumeralFactorFun
  28.388 - (open CancelNumeralFactorCommon
  28.389 -  val prove_conv = Bin_Simprocs.prove_conv
  28.390 -  val mk_bal   = HOLogic.mk_eq
  28.391 -  val dest_bal = HOLogic.dest_bin "op =" hyprealT
  28.392 -  val cancel = mult_cancel_left RS trans
  28.393 -  val neg_exchanges = false
  28.394 -)
  28.395 -
  28.396 -structure LessCancelNumeralFactor = CancelNumeralFactorFun
  28.397 - (open CancelNumeralFactorCommon
  28.398 -  val prove_conv = Bin_Simprocs.prove_conv
  28.399 -  val mk_bal   = HOLogic.mk_binrel "op <"
  28.400 -  val dest_bal = HOLogic.dest_bin "op <" hyprealT
  28.401 -  val cancel = mult_less_cancel_left RS trans
  28.402 -  val neg_exchanges = true
  28.403 -)
  28.404 -
  28.405 -structure LeCancelNumeralFactor = CancelNumeralFactorFun
  28.406 - (open CancelNumeralFactorCommon
  28.407 -  val prove_conv = Bin_Simprocs.prove_conv
  28.408 -  val mk_bal   = HOLogic.mk_binrel "op <="
  28.409 -  val dest_bal = HOLogic.dest_bin "op <=" hyprealT
  28.410 -  val cancel = mult_le_cancel_left RS trans
  28.411 -  val neg_exchanges = true
  28.412 -)
  28.413 -
  28.414 -val hypreal_cancel_numeral_factors_relations =
  28.415 -  map prep_simproc
  28.416 -   [("hyprealeq_cancel_numeral_factor",
  28.417 -     ["(l::hypreal) * m = n", "(l::hypreal) = m * n"],
  28.418 -     EqCancelNumeralFactor.proc),
  28.419 -    ("hyprealless_cancel_numeral_factor",
  28.420 -     ["(l::hypreal) * m < n", "(l::hypreal) < m * n"],
  28.421 -     LessCancelNumeralFactor.proc),
  28.422 -    ("hyprealle_cancel_numeral_factor",
  28.423 -     ["(l::hypreal) * m <= n", "(l::hypreal) <= m * n"],
  28.424 -     LeCancelNumeralFactor.proc)];
  28.425 -
  28.426 -val hypreal_cancel_numeral_factors_divide = prep_simproc
  28.427 -        ("hyprealdiv_cancel_numeral_factor",
  28.428 -         ["((l::hypreal) * m) / n", "(l::hypreal) / (m * n)",
  28.429 -          "((number_of v)::hypreal) / (number_of w)"],
  28.430 -         DivCancelNumeralFactor.proc);
  28.431 -
  28.432 -val hypreal_cancel_numeral_factors =
  28.433 -    hypreal_cancel_numeral_factors_relations @
  28.434 -    [hypreal_cancel_numeral_factors_divide];
  28.435 -
  28.436 -end;
  28.437 -
  28.438 -Addsimprocs hypreal_cancel_numeral_factors;
  28.439 -
  28.440 -
  28.441 -
  28.442 -(** Declarations for ExtractCommonTerm **)
  28.443 -
  28.444 -local
  28.445 -  open Hyperreal_Numeral_Simprocs
  28.446 -in
  28.447 -
  28.448 -structure CancelFactorCommon =
  28.449 -  struct
  28.450 -  val mk_sum            = long_mk_prod
  28.451 -  val dest_sum          = dest_prod
  28.452 -  val mk_coeff          = mk_coeff
  28.453 -  val dest_coeff        = dest_coeff
  28.454 -  val find_first        = find_first []
  28.455 -  val trans_tac         = Real_Numeral_Simprocs.trans_tac
  28.456 -  val norm_tac = ALLGOALS (simp_tac (HOL_ss addsimps mult_1s@mult_ac))
  28.457 -  end;
  28.458 -
  28.459 -structure EqCancelFactor = ExtractCommonTermFun
  28.460 - (open CancelFactorCommon
  28.461 -  val prove_conv = Bin_Simprocs.prove_conv
  28.462 -  val mk_bal   = HOLogic.mk_eq
  28.463 -  val dest_bal = HOLogic.dest_bin "op =" hyprealT
  28.464 -  val simplify_meta_eq  = cancel_simplify_meta_eq mult_cancel_left
  28.465 -);
  28.466 -
  28.467 -
  28.468 -structure DivideCancelFactor = ExtractCommonTermFun
  28.469 - (open CancelFactorCommon
  28.470 -  val prove_conv = Bin_Simprocs.prove_conv
  28.471 -  val mk_bal   = HOLogic.mk_binop "HOL.divide"
  28.472 -  val dest_bal = HOLogic.dest_bin "HOL.divide" hyprealT
  28.473 -  val simplify_meta_eq  = cancel_simplify_meta_eq mult_divide_cancel_eq_if
  28.474 -);
  28.475 -
  28.476 -val hypreal_cancel_factor =
  28.477 -  map prep_simproc
  28.478 -   [("hypreal_eq_cancel_factor", ["(l::hypreal) * m = n", "(l::hypreal) = m * n"],
  28.479 -     EqCancelFactor.proc),
  28.480 -    ("hypreal_divide_cancel_factor", ["((l::hypreal) * m) / n", "(l::hypreal) / (m * n)"],
  28.481 -     DivideCancelFactor.proc)];
  28.482 -
  28.483 -end;
  28.484 -
  28.485 -Addsimprocs hypreal_cancel_factor;
  28.486 -
  28.487 -
  28.488 -
  28.489 -
  28.490  (****Instantiation of the generic linear arithmetic package****)
  28.491  
  28.492  
  28.493  local
  28.494  
  28.495 -(* reduce contradictory <= to False *)
  28.496 -val add_rules =
  28.497 -    [hypreal_numeral_0_eq_0, hypreal_numeral_1_eq_1,
  28.498 -     add_hypreal_number_of, minus_hypreal_number_of, diff_hypreal_number_of,
  28.499 -     mult_hypreal_number_of, eq_hypreal_number_of, less_hypreal_number_of];
  28.500 -
  28.501 -val simprocs = [Hyperreal_Times_Assoc.conv, 
  28.502 -                Hyperreal_Numeral_Simprocs.combine_numerals,
  28.503 -                hypreal_cancel_numeral_factors_divide]@
  28.504 -               Hyperreal_Numeral_Simprocs.cancel_numerals @
  28.505 -               Hyperreal_Numeral_Simprocs.eval_numerals;
  28.506 -
  28.507  fun cvar(th,_ $ (_ $ _ $ var)) = cterm_of (#sign(rep_thm th)) var;
  28.508  
  28.509  val hypreal_mult_mono_thms =
  28.510 @@ -529,6 +34,8 @@
  28.511  
  28.512  in
  28.513  
  28.514 +val hyprealT = Type("Rational.hypreal", []);
  28.515 +
  28.516  val fast_hypreal_arith_simproc =
  28.517      Simplifier.simproc (Theory.sign_of (the_context ()))
  28.518        "fast_hypreal_arith" 
  28.519 @@ -541,10 +48,8 @@
  28.520      mult_mono_thms = mult_mono_thms @ hypreal_mult_mono_thms,
  28.521      inj_thms = inj_thms @ real_inj_thms, 
  28.522      lessD = lessD,  (*Can't change LA_Data_Ref.lessD: the hypreals are dense!*)
  28.523 -    simpset = simpset addsimps add_rules
  28.524 -                      addsimprocs simprocs}),
  28.525 -  arith_inj_const ("HyperDef.hypreal_of_real", 
  28.526 -                   HOLogic.realT --> Hyperreal_Numeral_Simprocs.hyprealT),
  28.527 +    simpset = simpset}),
  28.528 +  arith_inj_const ("HyperDef.hypreal_of_real", HOLogic.realT --> hyprealT),
  28.529    arith_discrete ("HyperDef.hypreal",false),
  28.530    Simplifier.change_simpset_of (op addsimprocs) [fast_hypreal_arith_simproc]];
  28.531  
    29.1 --- a/src/HOL/Integ/Bin.thy	Sat Feb 14 02:06:12 2004 +0100
    29.2 +++ b/src/HOL/Integ/Bin.thy	Sun Feb 15 10:46:37 2004 +0100
    29.3 @@ -10,332 +10,266 @@
    29.4  
    29.5  theory Bin = IntDef + Numeral:
    29.6  
    29.7 -text{*The sign @{term Pls} stands for an infinite string of leading Falses.*}
    29.8 -text{*The sign @{term Min} stands for an infinite string of leading Trues.*}
    29.9 -
   29.10 -text{*A number can have multiple representations, namely leading Falses with
   29.11 -sign @{term Pls} and leading Trues with sign @{term Min}.
   29.12 -See @{text "ZF/Integ/twos-compl.ML"}, function @{text int_of_binary},
   29.13 -for the numerical interpretation.
   29.14 -
   29.15 -The representation expects that @{term "(m mod 2)"} is 0 or 1,
   29.16 -even if m is negative;
   29.17 -For instance, @{term "-5 div 2 = -3"} and @{term "-5 mod 2 = 1"}; thus
   29.18 -@{term "-5 = (-3)*2 + 1"}.
   29.19 -*}
   29.20 -
   29.21 -consts
   29.22 -  NCons     :: "[bin,bool]=>bin"
   29.23 -  bin_succ  :: "bin=>bin"
   29.24 -  bin_pred  :: "bin=>bin"
   29.25 -  bin_minus :: "bin=>bin"
   29.26 -  bin_add   :: "[bin,bin]=>bin"
   29.27 -  bin_mult  :: "[bin,bin]=>bin"
   29.28 -
   29.29 -(*NCons inserts a bit, suppressing leading 0s and 1s*)
   29.30 -primrec
   29.31 -  NCons_Pls:  "NCons bin.Pls b = (if b then (bin.Pls BIT b) else bin.Pls)"
   29.32 -  NCons_Min:  "NCons bin.Min b = (if b then bin.Min else (bin.Min BIT b))"
   29.33 -  NCons_BIT:  "NCons (w BIT x) b = (w BIT x) BIT b"
   29.34 -
   29.35 -instance
   29.36 -  int :: number ..
   29.37 -
   29.38 -primrec (*the type constraint is essential!*)
   29.39 +axclass number_ring \<subseteq> number, ring
   29.40    number_of_Pls: "number_of bin.Pls = 0"
   29.41 -  number_of_Min: "number_of bin.Min = - (1::int)"
   29.42 +  number_of_Min: "number_of bin.Min = - 1"
   29.43    number_of_BIT: "number_of(w BIT x) = (if x then 1 else 0) +
   29.44  	                               (number_of w) + (number_of w)"
   29.45 +subsection{*Converting Numerals to Rings: @{term number_of}*}
   29.46  
   29.47 -primrec
   29.48 -  bin_succ_Pls: "bin_succ bin.Pls = bin.Pls BIT True"
   29.49 -  bin_succ_Min: "bin_succ bin.Min = bin.Pls"
   29.50 -  bin_succ_BIT: "bin_succ(w BIT x) =
   29.51 -  	            (if x then bin_succ w BIT False
   29.52 -	                  else NCons w True)"
   29.53 -
   29.54 -primrec
   29.55 -  bin_pred_Pls: "bin_pred bin.Pls = bin.Min"
   29.56 -  bin_pred_Min: "bin_pred bin.Min = bin.Min BIT False"
   29.57 -  bin_pred_BIT: "bin_pred(w BIT x) =
   29.58 -	            (if x then NCons w False
   29.59 -		          else (bin_pred w) BIT True)"
   29.60 +lemmas number_of = number_of_Pls number_of_Min number_of_BIT
   29.61  
   29.62 -primrec
   29.63 -  bin_minus_Pls: "bin_minus bin.Pls = bin.Pls"
   29.64 -  bin_minus_Min: "bin_minus bin.Min = bin.Pls BIT True"
   29.65 -  bin_minus_BIT: "bin_minus(w BIT x) =
   29.66 -	             (if x then bin_pred (NCons (bin_minus w) False)
   29.67 -		           else bin_minus w BIT False)"
   29.68 -
   29.69 -primrec
   29.70 -  bin_add_Pls: "bin_add bin.Pls w = w"
   29.71 -  bin_add_Min: "bin_add bin.Min w = bin_pred w"
   29.72 -  bin_add_BIT:
   29.73 -    "bin_add (v BIT x) w =
   29.74 -       (case w of Pls => v BIT x
   29.75 -                | Min => bin_pred (v BIT x)
   29.76 -                | (w BIT y) =>
   29.77 -      	            NCons (bin_add v (if (x & y) then bin_succ w else w))
   29.78 -	                  (x~=y))"
   29.79 -
   29.80 -primrec
   29.81 -  bin_mult_Pls: "bin_mult bin.Pls w = bin.Pls"
   29.82 -  bin_mult_Min: "bin_mult bin.Min w = bin_minus w"
   29.83 -  bin_mult_BIT: "bin_mult (v BIT x) w =
   29.84 -	            (if x then (bin_add (NCons (bin_mult v w) False) w)
   29.85 -	                  else (NCons (bin_mult v w) False))"
   29.86 +lemma number_of_NCons [simp]:
   29.87 +     "number_of(NCons w b) = (number_of(w BIT b)::'a::number_ring)"
   29.88 +by (induct_tac "w", simp_all add: number_of)
   29.89  
   29.90 -
   29.91 -(** extra rules for bin_succ, bin_pred, bin_add, bin_mult **)
   29.92 -
   29.93 -lemma NCons_Pls_0: "NCons bin.Pls False = bin.Pls"
   29.94 -by simp
   29.95 -
   29.96 -lemma NCons_Pls_1: "NCons bin.Pls True = bin.Pls BIT True"
   29.97 -by simp
   29.98 -
   29.99 -lemma NCons_Min_0: "NCons bin.Min False = bin.Min BIT False"
  29.100 -by simp
  29.101 -
  29.102 -lemma NCons_Min_1: "NCons bin.Min True = bin.Min"
  29.103 -by simp
  29.104 -
  29.105 -lemma bin_succ_1: "bin_succ(w BIT True) = (bin_succ w) BIT False"
  29.106 -by simp
  29.107 +lemma number_of_succ: "number_of(bin_succ w) = (1 + number_of w ::'a::number_ring)"
  29.108 +apply (induct_tac "w")
  29.109 +apply (simp_all add: number_of add_ac)
  29.110 +done
  29.111  
  29.112 -lemma bin_succ_0: "bin_succ(w BIT False) =  NCons w True"
  29.113 -by simp
  29.114 -
  29.115 -lemma bin_pred_1: "bin_pred(w BIT True) = NCons w False"
  29.116 -by simp
  29.117 -
  29.118 -lemma bin_pred_0: "bin_pred(w BIT False) = (bin_pred w) BIT True"
  29.119 -by simp
  29.120 +lemma number_of_pred: "number_of(bin_pred w) = (- 1 + number_of w ::'a::number_ring)"
  29.121 +apply (induct_tac "w")
  29.122 +apply (simp_all add: number_of add_assoc [symmetric]) 
  29.123 +apply (simp add: add_ac)
  29.124 +done
  29.125  
  29.126 -lemma bin_minus_1: "bin_minus(w BIT True) = bin_pred (NCons (bin_minus w) False)"
  29.127 -by simp
  29.128 -
  29.129 -lemma bin_minus_0: "bin_minus(w BIT False) = (bin_minus w) BIT False"
  29.130 -by simp
  29.131 -
  29.132 -
  29.133 -(*** bin_add: binary addition ***)
  29.134 -
  29.135 -lemma bin_add_BIT_11: "bin_add (v BIT True) (w BIT True) =
  29.136 -     NCons (bin_add v (bin_succ w)) False"
  29.137 -apply simp
  29.138 +lemma number_of_minus: "number_of(bin_minus w) = (- (number_of w)::'a::number_ring)"
  29.139 +apply (induct_tac "w")
  29.140 +apply (simp_all del: bin_pred_Pls bin_pred_Min bin_pred_BIT 
  29.141 +            add: number_of number_of_succ number_of_pred add_assoc)
  29.142  done
  29.143  
  29.144 -lemma bin_add_BIT_10: "bin_add (v BIT True) (w BIT False) = NCons (bin_add v w) True"
  29.145 -by simp
  29.146 -
  29.147 -lemma bin_add_BIT_0: "bin_add (v BIT False) (w BIT y) = NCons (bin_add v w) y"
  29.148 -by auto
  29.149 +text{*This proof is complicated by the mutual recursion*}
  29.150 +lemma number_of_add [rule_format]:
  29.151 +     "\<forall>w. number_of(bin_add v w) = (number_of v + number_of w::'a::number_ring)"
  29.152 +apply (induct_tac "v")
  29.153 +apply (simp add: number_of)
  29.154 +apply (simp add: number_of number_of_pred)
  29.155 +apply (rule allI)
  29.156 +apply (induct_tac "w")
  29.157 +apply (simp_all add: number_of bin_add_BIT_BIT number_of_succ number_of_pred add_ac)
  29.158 +apply (simp add: add_left_commute [of "1::'a::number_ring"]) 
  29.159 +done
  29.160  
  29.161 -lemma bin_add_Pls_right: "bin_add w bin.Pls = w"
  29.162 -by (induct_tac "w", auto)
  29.163 +lemma number_of_mult:
  29.164 +     "number_of(bin_mult v w) = (number_of v * number_of w::'a::number_ring)"
  29.165 +apply (induct_tac "v", simp add: number_of) 
  29.166 +apply (simp add: number_of number_of_minus) 
  29.167 +apply (simp add: number_of number_of_add left_distrib add_ac)
  29.168 +done
  29.169  
  29.170 -lemma bin_add_Min_right: "bin_add w bin.Min = bin_pred w"
  29.171 -by (induct_tac "w", auto)
  29.172 -
  29.173 -lemma bin_add_BIT_BIT: "bin_add (v BIT x) (w BIT y) =
  29.174 -     NCons(bin_add v (if x & y then (bin_succ w) else w)) (x~= y)"
  29.175 -apply simp
  29.176 +text{*The correctness of shifting.  But it doesn't seem to give a measurable
  29.177 +  speed-up.*}
  29.178 +lemma double_number_of_BIT:
  29.179 +     "(1+1) * number_of w = (number_of (w BIT False) ::'a::number_ring)"
  29.180 +apply (induct_tac "w")
  29.181 +apply (simp_all add: number_of number_of_add left_distrib add_ac)
  29.182  done
  29.183  
  29.184  
  29.185 -(*** bin_mult: binary multiplication ***)
  29.186 +text{*Converting numerals 0 and 1 to their abstract versions*}
  29.187 +lemma numeral_0_eq_0 [simp]: "Numeral0 = (0::'a::number_ring)"
  29.188 +by (simp add: number_of) 
  29.189 +
  29.190 +lemma numeral_1_eq_1 [simp]: "Numeral1 = (1::'a::number_ring)"
  29.191 +by (simp add: number_of) 
  29.192  
  29.193 -lemma bin_mult_1: "bin_mult (v BIT True) w = bin_add (NCons (bin_mult v w) False) w"
  29.194 -by simp
  29.195 +text{*Special-case simplification for small constants*}
  29.196 +
  29.197 +text{*Unary minus for the abstract constant 1. Cannot be inserted
  29.198 +  as a simprule until later: it is @{text number_of_Min} re-oriented!*}
  29.199 +lemma numeral_m1_eq_minus_1: "(-1::'a::number_ring) = - 1"
  29.200 +by (simp add: number_of)
  29.201  
  29.202 -lemma bin_mult_0: "bin_mult (v BIT False) w = NCons (bin_mult v w) False"
  29.203 -by simp
  29.204 +lemma mult_minus1 [simp]: "-1 * z = -(z::'a::number_ring)"
  29.205 +by (simp add: numeral_m1_eq_minus_1)
  29.206 +
  29.207 +lemma mult_minus1_right [simp]: "z * -1 = -(z::'a::number_ring)"
  29.208 +by (simp add: numeral_m1_eq_minus_1)
  29.209  
  29.210 +(*Negation of a coefficient*)
  29.211 +lemma minus_number_of_mult [simp]:
  29.212 +     "- (number_of w) * z = number_of(bin_minus w) * (z::'a::number_ring)"
  29.213 +by (simp add: number_of_minus)
  29.214  
  29.215 -(**** The carry/borrow functions, bin_succ and bin_pred ****)
  29.216 +text{*Subtraction*}
  29.217 +lemma diff_number_of_eq:
  29.218 +     "number_of v - number_of w =
  29.219 +      (number_of(bin_add v (bin_minus w))::'a::number_ring)"
  29.220 +by (simp add: diff_minus number_of_add number_of_minus)
  29.221  
  29.222  
  29.223 -(** number_of **)
  29.224 -
  29.225 -lemma number_of_NCons [simp]:
  29.226 -     "number_of(NCons w b) = (number_of(w BIT b)::int)"
  29.227 -apply (induct_tac "w")
  29.228 -apply (simp_all)
  29.229 -done
  29.230 +subsection{*Equality of Binary Numbers*}
  29.231  
  29.232 -lemma number_of_succ: "number_of(bin_succ w) = (1 + number_of w :: int)"
  29.233 -apply (induct_tac "w")
  29.234 -apply (simp_all add: zadd_ac)
  29.235 -done
  29.236 -
  29.237 -lemma number_of_pred: "number_of(bin_pred w) = (- 1 + number_of w :: int)"
  29.238 -apply (induct_tac "w")
  29.239 -apply (simp_all add: add_assoc [symmetric]) 
  29.240 -apply (simp add: zadd_ac)
  29.241 -done
  29.242 -
  29.243 -lemma number_of_minus: "number_of(bin_minus w) = (- (number_of w)::int)"
  29.244 -apply (induct_tac "w", simp, simp)
  29.245 -apply (simp del: bin_pred_Pls bin_pred_Min bin_pred_BIT add: number_of_succ number_of_pred zadd_assoc)
  29.246 -done
  29.247 +text{*First version by Norbert Voelker*}
  29.248  
  29.249 -(*This proof is complicated by the mutual recursion*)
  29.250 -lemma number_of_add [rule_format (no_asm)]: "! w. number_of(bin_add v w) = (number_of v + number_of w::int)"
  29.251 -apply (induct_tac "v", simp)
  29.252 -apply (simp add: number_of_pred)
  29.253 -apply (rule allI)
  29.254 -apply (induct_tac "w")
  29.255 -apply (simp_all add: bin_add_BIT_BIT number_of_succ number_of_pred add_ac)
  29.256 -apply (simp add: add_left_commute [of "1::int"]) 
  29.257 -done
  29.258 -
  29.259 +lemma eq_number_of_eq:
  29.260 +  "((number_of x::'a::number_ring) = number_of y) =
  29.261 +   iszero (number_of (bin_add x (bin_minus y)) :: 'a)"
  29.262 +by (simp add: iszero_def compare_rls number_of_add number_of_minus)
  29.263  
  29.264 -(*Subtraction*)
  29.265 -lemma diff_number_of_eq:
  29.266 -     "number_of v - number_of w = (number_of(bin_add v (bin_minus w))::int)"
  29.267 -apply (unfold zdiff_def)
  29.268 -apply (simp add: number_of_add number_of_minus)
  29.269 -done
  29.270 +lemma iszero_number_of_Pls: "iszero ((number_of bin.Pls)::'a::number_ring)"
  29.271 +by (simp add: iszero_def numeral_0_eq_0)
  29.272  
  29.273 -lemmas bin_mult_simps = 
  29.274 -       int_Suc0_eq_1 zmult_zminus number_of_minus number_of_add
  29.275 -
  29.276 -lemma number_of_mult: "number_of(bin_mult v w) = (number_of v * number_of w::int)"
  29.277 -apply (induct_tac "v")
  29.278 -apply (simp add: bin_mult_simps)
  29.279 -apply (simp add: bin_mult_simps)
  29.280 -apply (simp add: bin_mult_simps zadd_zmult_distrib zadd_ac)
  29.281 -done
  29.282 +lemma nonzero_number_of_Min: "~ iszero ((number_of bin.Min)::'a::number_ring)"
  29.283 +by (simp add: iszero_def numeral_m1_eq_minus_1 eq_commute)
  29.284  
  29.285  
  29.286 -(*The correctness of shifting.  But it doesn't seem to give a measurable
  29.287 -  speed-up.*)
  29.288 -lemma double_number_of_BIT: "(2::int) * number_of w = number_of (w BIT False)"
  29.289 -apply (induct_tac "w")
  29.290 -apply (simp_all add: bin_mult_simps zadd_zmult_distrib zadd_ac)
  29.291 -done
  29.292 +subsection{*Comparisons, for Ordered Rings*}
  29.293 +
  29.294 +lemma double_eq_0_iff: "(a + a = 0) = (a = (0::'a::ordered_ring))"
  29.295 +proof -
  29.296 +  have "a + a = (1+1)*a" by (simp add: left_distrib)
  29.297 +  with zero_less_two [where 'a = 'a]
  29.298 +  show ?thesis by force
  29.299 +qed
  29.300  
  29.301 -
  29.302 -(** Converting numerals 0 and 1 to their abstract versions **)
  29.303 -
  29.304 -lemma int_numeral_0_eq_0: "Numeral0 = (0::int)"
  29.305 -by simp
  29.306 +lemma le_imp_0_less: 
  29.307 +  assumes le: "0 \<le> z" shows "(0::int) < 1 + z"
  29.308 +proof -
  29.309 +  have "0 \<le> z" .
  29.310 +  also have "... < z + 1" by (rule less_add_one) 
  29.311 +  also have "... = 1 + z" by (simp add: add_ac)
  29.312 +  finally show "0 < 1 + z" .
  29.313 +qed
  29.314  
  29.315 -lemma int_numeral_1_eq_1: "Numeral1 = (1::int)"
  29.316 -by (simp add: int_1 int_Suc0_eq_1)
  29.317 -
  29.318 -(*Moving negation out of products: so far for type "int" only*)
  29.319 -declare zmult_zminus [simp] zmult_zminus_right [simp]
  29.320 -
  29.321 -
  29.322 -(** Special-case simplification for small constants **)
  29.323 -
  29.324 -lemma zmult_minus1 [simp]: "-1 * z = -(z::int)"
  29.325 -by (simp add: compare_rls int_Suc0_eq_1 zmult_zminus)
  29.326 -
  29.327 -lemma zmult_minus1_right [simp]: "z * -1 = -(z::int)"
  29.328 -by (subst zmult_commute, rule zmult_minus1)
  29.329 +lemma odd_nonzero: "1 + z + z \<noteq> (0::int)";
  29.330 +proof (cases z rule: int_cases)
  29.331 +  case (nonneg n)
  29.332 +  have le: "0 \<le> z+z" by (simp add: prems add_increasing) 
  29.333 +  thus ?thesis using  le_imp_0_less [OF le]
  29.334 +    by (auto simp add: add_assoc) 
  29.335 +next
  29.336 +  case (neg n)
  29.337 +  show ?thesis
  29.338 +  proof
  29.339 +    assume eq: "1 + z + z = 0"
  29.340 +    have "0 < 1 + (int n + int n)"
  29.341 +      by (simp add: le_imp_0_less add_increasing) 
  29.342 +    also have "... = - (1 + z + z)" by (simp add: prems int_Suc add_ac) 
  29.343 +    also have "... = 0" by (simp add: eq) 
  29.344 +    finally have "0<0" ..
  29.345 +    thus False by blast
  29.346 +  qed
  29.347 +qed
  29.348  
  29.349  
  29.350 -(*Negation of a coefficient*)
  29.351 -lemma zminus_number_of_zmult [simp]: "- (number_of w) * z = number_of(bin_minus w) * (z::int)"
  29.352 -by (simp add: number_of_minus zmult_zminus)
  29.353 -
  29.354 -(*Integer unary minus for the abstract constant 1. Cannot be inserted
  29.355 -  as a simprule until later: it is number_of_Min re-oriented!*)
  29.356 -lemma zminus_1_eq_m1: "- 1 = (-1::int)"
  29.357 -by simp
  29.358 -
  29.359 -lemma zero_less_nat_eq [simp]: "(0 < nat z) = (0 < z)"
  29.360 -by (cut_tac w = 0 in zless_nat_conj, auto)
  29.361 -
  29.362 -
  29.363 -(** Simplification rules for comparison of binary numbers (Norbert Voelker) **)
  29.364 +text{*The premise involving @{term Ints} prevents @{term "a = 1/2"}.*}
  29.365 +lemma Ints_odd_nonzero: "a \<in> Ints ==> 1 + a + a \<noteq> (0::'a::ordered_ring)"
  29.366 +proof (unfold Ints_def) 
  29.367 +  assume "a \<in> range of_int"
  29.368 +  from this obtain z where a: "a = of_int z" ..
  29.369 +  show ?thesis
  29.370 +  proof
  29.371 +    assume eq: "1 + a + a = 0"
  29.372 +    hence "of_int (1 + z + z) = (of_int 0 :: 'a)" by (simp add: a)
  29.373 +    hence "1 + z + z = 0" by (simp only: of_int_eq_iff)
  29.374 +    with odd_nonzero show False by blast
  29.375 +  qed
  29.376 +qed 
  29.377  
  29.378 -(** Equals (=) **)
  29.379 -
  29.380 -lemma eq_number_of_eq:
  29.381 -  "((number_of x::int) = number_of y) =
  29.382 -   iszero (number_of (bin_add x (bin_minus y)) :: int)"
  29.383 -apply (unfold iszero_def)
  29.384 -apply (simp add: compare_rls number_of_add number_of_minus)
  29.385 -done
  29.386 -
  29.387 -lemma iszero_number_of_Pls: "iszero ((number_of bin.Pls)::int)"
  29.388 -by (unfold iszero_def, simp)
  29.389 -
  29.390 -lemma nonzero_number_of_Min: "~ iszero ((number_of bin.Min)::int)"
  29.391 -apply (unfold iszero_def)
  29.392 -apply (simp add: eq_commute)
  29.393 -done
  29.394 +lemma Ints_number_of: "(number_of w :: 'a::number_ring) \<in> Ints"
  29.395 +by (induct_tac "w", simp_all add: number_of)
  29.396  
  29.397  lemma iszero_number_of_BIT:
  29.398 -     "iszero (number_of (w BIT x)::int) = (~x & iszero (number_of w::int))"
  29.399 -apply (unfold iszero_def)
  29.400 -apply (cases "(number_of w)::int" rule: int_cases) 
  29.401 -apply (simp_all (no_asm_simp) add: compare_rls zero_reorient
  29.402 -         zminus_zadd_distrib [symmetric] int_Suc0_eq_1 [symmetric] zadd_int)
  29.403 -done
  29.404 +     "iszero (number_of (w BIT x)::'a) = 
  29.405 +      (~x & iszero (number_of w::'a::{ordered_ring,number_ring}))"
  29.406 +by (simp add: iszero_def compare_rls zero_reorient double_eq_0_iff 
  29.407 +              number_of Ints_odd_nonzero [OF Ints_number_of])
  29.408  
  29.409  lemma iszero_number_of_0:
  29.410 -     "iszero (number_of (w BIT False)::int) = iszero (number_of w::int)"
  29.411 +     "iszero (number_of (w BIT False) :: 'a::{ordered_ring,number_ring}) = 
  29.412 +      iszero (number_of w :: 'a)"
  29.413  by (simp only: iszero_number_of_BIT simp_thms)
  29.414  
  29.415 -lemma iszero_number_of_1: "~ iszero (number_of (w BIT True)::int)"
  29.416 +lemma iszero_number_of_1:
  29.417 +     "~ iszero (number_of (w BIT True)::'a::{ordered_ring,number_ring})"
  29.418  by (simp only: iszero_number_of_BIT simp_thms)
  29.419  
  29.420  
  29.421  
  29.422 -(** Less-than (<) **)
  29.423 +subsection{*The Less-Than Relation*}
  29.424  
  29.425  lemma less_number_of_eq_neg:
  29.426 -    "((number_of x::int) < number_of y)
  29.427 -     = neg (number_of (bin_add x (bin_minus y)) ::int )"
  29.428 -by (simp add: neg_def number_of_add number_of_minus compare_rls) 
  29.429 +    "((number_of x::'a::{ordered_ring,number_ring}) < number_of y)
  29.430 +     = neg (number_of (bin_add x (bin_minus y)) :: 'a)"
  29.431 +apply (subst less_iff_diff_less_0) 
  29.432 +apply (simp add: neg_def diff_minus number_of_add number_of_minus)
  29.433 +done
  29.434 +
  29.435 +text{*If @{term Numeral0} is rewritten to 0 then this rule can't be applied:
  29.436 +  @{term Numeral0} IS @{term "number_of Pls"} *}
  29.437 +lemma not_neg_number_of_Pls:
  29.438 +     "~ neg (number_of bin.Pls ::'a::{ordered_ring,number_ring})"
  29.439 +by (simp add: neg_def numeral_0_eq_0)
  29.440 +
  29.441 +lemma neg_number_of_Min:
  29.442 +     "neg (number_of bin.Min ::'a::{ordered_ring,number_ring})"
  29.443 +by (simp add: neg_def zero_less_one numeral_m1_eq_minus_1)
  29.444 +
  29.445 +lemma double_less_0_iff: "(a + a < 0) = (a < (0::'a::ordered_ring))"
  29.446 +proof -
  29.447 +  have "(a + a < 0) = ((1+1)*a < 0)" by (simp add: left_distrib)
  29.448 +  also have "... = (a < 0)"
  29.449 +    by (simp add: mult_less_0_iff zero_less_two 
  29.450 +                  order_less_not_sym [OF zero_less_two]) 
  29.451 +  finally show ?thesis .
  29.452 +qed
  29.453 +
  29.454 +lemma odd_less_0: "(1 + z + z < 0) = (z < (0::int))";
  29.455 +proof (cases z rule: int_cases)
  29.456 +  case (nonneg n)
  29.457 +  thus ?thesis by (simp add: linorder_not_less add_assoc add_increasing
  29.458 +                             le_imp_0_less [THEN order_less_imp_le])  
  29.459 +next
  29.460 +  case (neg n)
  29.461 +  thus ?thesis by (simp del: int_Suc
  29.462 +			add: int_Suc0_eq_1 [symmetric] zadd_int compare_rls)
  29.463 +qed
  29.464 +
  29.465 +text{*The premise involving @{term Ints} prevents @{term "a = 1/2"}.*}
  29.466 +lemma Ints_odd_less_0: 
  29.467 +     "a \<in> Ints ==> (1 + a + a < 0) = (a < (0::'a::ordered_ring))";
  29.468 +proof (unfold Ints_def) 
  29.469 +  assume "a \<in> range of_int"
  29.470 +  from this obtain z where a: "a = of_int z" ..
  29.471 +  hence "((1::'a) + a + a < 0) = (of_int (1 + z + z) < (of_int 0 :: 'a))"
  29.472 +    by (simp add: prems)
  29.473 +  also have "... = (z < 0)" by (simp only: of_int_less_iff odd_less_0)
  29.474 +  also have "... = (a < 0)" by (simp add: prems)
  29.475 +  finally show ?thesis .
  29.476 +qed
  29.477 +
  29.478 +lemma neg_number_of_BIT:
  29.479 +     "neg (number_of (w BIT x)::'a) = 
  29.480 +      neg (number_of w :: 'a::{ordered_ring,number_ring})"
  29.481 +by (simp add: number_of neg_def double_less_0_iff
  29.482 +              Ints_odd_less_0 [OF Ints_number_of])
  29.483  
  29.484  
  29.485 -(*But if Numeral0 is rewritten to 0 then this rule can't be applied:
  29.486 -  Numeral0 IS (number_of Pls) *)
  29.487 -lemma not_neg_number_of_Pls: "~ neg (number_of bin.Pls ::int)"
  29.488 -by (simp add: neg_def)
  29.489 -
  29.490 -lemma neg_number_of_Min: "neg (number_of bin.Min ::int)"
  29.491 -by (simp add: neg_def int_0_less_1)
  29.492 -
  29.493 -lemma neg_number_of_BIT:
  29.494 -     "neg (number_of (w BIT x)::int) = neg (number_of w ::int)"
  29.495 -apply simp
  29.496 -apply (cases "(number_of w)::int" rule: int_cases) 
  29.497 -apply (simp_all (no_asm_simp) add: int_Suc0_eq_1 [symmetric] zadd_int neg_def zdiff_def [symmetric] compare_rls)
  29.498 -done
  29.499 -
  29.500 -
  29.501 -(** Less-than-or-equals (\<le>) **)
  29.502 +text{*Less-Than or Equals*}
  29.503  
  29.504  text{*Reduces @{term "a\<le>b"} to @{term "~ (b<a)"} for ALL numerals*}
  29.505  lemmas le_number_of_eq_not_less =
  29.506 -       linorder_not_less [of "number_of w" "number_of v", symmetric, standard]
  29.507 +       linorder_not_less [of "number_of w" "number_of v", symmetric, 
  29.508 +                          standard]
  29.509  
  29.510 -declare le_number_of_eq_not_less [simp]
  29.511 +lemma le_number_of_eq:
  29.512 +    "((number_of x::'a::{ordered_ring,number_ring}) \<le> number_of y)
  29.513 +     = (~ (neg (number_of (bin_add y (bin_minus x)) :: 'a)))"
  29.514 +by (simp add: le_number_of_eq_not_less less_number_of_eq_neg)
  29.515  
  29.516  
  29.517 -(** Absolute value (abs) **)
  29.518 -
  29.519 -lemma zabs_number_of:
  29.520 - "abs(number_of x::int) =
  29.521 -  (if number_of x < (0::int) then -number_of x else number_of x)"
  29.522 -by (simp add: zabs_def)
  29.523 +text{*Absolute value (@{term abs})*}
  29.524  
  29.525 -(*0 and 1 require special rewrites because they aren't numerals*)
  29.526 -lemma zabs_0: "abs (0::int) = 0"
  29.527 -by (simp add: zabs_def)
  29.528 +lemma abs_number_of:
  29.529 +     "abs(number_of x::'a::{ordered_ring,number_ring}) =
  29.530 +      (if number_of x < (0::'a) then -number_of x else number_of x)"
  29.531 +by (simp add: abs_if)
  29.532  
  29.533 -lemma zabs_1: "abs (1::int) = 1"
  29.534 -by (simp del: int_0 int_1 add: int_0 [symmetric] int_1 [symmetric] zabs_def)
  29.535  
  29.536 -(*Re-orientation of the equation nnn=x*)
  29.537 +text{*Re-orientation of the equation nnn=x*}
  29.538  lemma number_of_reorient: "(number_of w = x) = (x = number_of w)"
  29.539  by auto
  29.540  
  29.541 @@ -360,14 +294,14 @@
  29.542  
  29.543  lemmas bin_arith_extra_simps = 
  29.544         number_of_add [symmetric]
  29.545 -       number_of_minus [symmetric] zminus_1_eq_m1
  29.546 +       number_of_minus [symmetric] numeral_m1_eq_minus_1 [symmetric]
  29.547         number_of_mult [symmetric]
  29.548         bin_succ_1 bin_succ_0
  29.549         bin_pred_1 bin_pred_0
  29.550         bin_minus_1 bin_minus_0
  29.551         bin_add_Pls_right bin_add_Min_right
  29.552         bin_add_BIT_0 bin_add_BIT_10 bin_add_BIT_11
  29.553 -       diff_number_of_eq zabs_number_of zabs_0 zabs_1
  29.554 +       diff_number_of_eq abs_number_of abs_zero abs_one
  29.555         bin_mult_1 bin_mult_0 NCons_simps
  29.556  
  29.557  (*For making a minimal simpset, one must include these default simprules
  29.558 @@ -386,47 +320,33 @@
  29.559         less_number_of_eq_neg
  29.560         not_neg_number_of_Pls not_neg_0 not_neg_1 not_iszero_1
  29.561         neg_number_of_Min neg_number_of_BIT
  29.562 -       le_number_of_eq_not_less
  29.563 +       le_number_of_eq
  29.564  
  29.565  declare bin_arith_extra_simps [simp]
  29.566  declare bin_rel_simps [simp]
  29.567  
  29.568  
  29.569 -(** Simplification of arithmetic when nested to the right **)
  29.570 +subsection{*Simplification of arithmetic when nested to the right*}
  29.571  
  29.572 -lemma add_number_of_left [simp]: "number_of v + (number_of w + z) = (number_of(bin_add v w) + z::int)"
  29.573 -by (simp add: zadd_assoc [symmetric])
  29.574 +lemma add_number_of_left [simp]:
  29.575 +     "number_of v + (number_of w + z) =
  29.576 +      (number_of(bin_add v w) + z::'a::number_ring)"
  29.577 +by (simp add: add_assoc [symmetric])
  29.578  
  29.579 -lemma mult_number_of_left [simp]: "number_of v * (number_of w * z) = (number_of(bin_mult v w) * z::int)"
  29.580 -by (simp add: zmult_assoc [symmetric])
  29.581 +lemma mult_number_of_left [simp]:
  29.582 +    "number_of v * (number_of w * z) =
  29.583 +     (number_of(bin_mult v w) * z::'a::number_ring)"
  29.584 +by (simp add: mult_assoc [symmetric])
  29.585  
  29.586  lemma add_number_of_diff1:
  29.587 -    "number_of v + (number_of w - c) = number_of(bin_add v w) - (c::int)"
  29.588 -apply (unfold zdiff_def)
  29.589 -apply (rule add_number_of_left)
  29.590 -done
  29.591 +    "number_of v + (number_of w - c) = 
  29.592 +     number_of(bin_add v w) - (c::'a::number_ring)"
  29.593 +by (simp add: diff_minus add_number_of_left)
  29.594  
  29.595  lemma add_number_of_diff2 [simp]: "number_of v + (c - number_of w) =
  29.596 -     number_of (bin_add v (bin_minus w)) + (c::int)"
  29.597 +     number_of (bin_add v (bin_minus w)) + (c::'a::number_ring)"
  29.598  apply (subst diff_number_of_eq [symmetric])
  29.599  apply (simp only: compare_rls)
  29.600  done
  29.601  
  29.602 -
  29.603 -
  29.604 -(** Inserting these natural simprules earlier would break many proofs! **)
  29.605 -
  29.606 -(* int (Suc n) = 1 + int n *)
  29.607 -declare int_Suc [simp]
  29.608 -
  29.609 -(* Numeral0 -> 0 and Numeral1 -> 1 *)
  29.610 -declare int_numeral_0_eq_0 [simp] int_numeral_1_eq_1 [simp]
  29.611 -
  29.612 -
  29.613 -(*Simplification of  x-y < 0, etc.*)
  29.614 -declare less_iff_diff_less_0 [symmetric, simp]
  29.615 -declare eq_iff_diff_eq_0 [symmetric, simp]
  29.616 -declare le_iff_diff_le_0 [symmetric, simp]
  29.617 -
  29.618 -
  29.619  end
    30.1 --- a/src/HOL/Integ/IntArith.thy	Sat Feb 14 02:06:12 2004 +0100
    30.2 +++ b/src/HOL/Integ/IntArith.thy	Sun Feb 15 10:46:37 2004 +0100
    30.3 @@ -8,9 +8,41 @@
    30.4  theory IntArith = Bin
    30.5  files ("int_arith1.ML"):
    30.6  
    30.7 +text{*Duplicate: can't understand why it's necessary*}
    30.8 +declare numeral_0_eq_0 [simp]
    30.9 +
   30.10 +subsection{*Instantiating Binary Arithmetic for the Integers*}
   30.11 +
   30.12 +instance
   30.13 +  int :: number ..
   30.14 +
   30.15 +primrec (*the type constraint is essential!*)
   30.16 +  number_of_Pls: "number_of bin.Pls = 0"
   30.17 +  number_of_Min: "number_of bin.Min = - (1::int)"
   30.18 +  number_of_BIT: "number_of(w BIT x) = (if x then 1 else 0) +
   30.19 +	                               (number_of w) + (number_of w)"
   30.20 +
   30.21 +declare number_of_Pls [simp del]
   30.22 +        number_of_Min [simp del]
   30.23 +        number_of_BIT [simp del]
   30.24 +
   30.25 +instance int :: number_ring
   30.26 +proof
   30.27 +  show "Numeral0 = (0::int)" by (rule number_of_Pls)
   30.28 +  show "-1 = - (1::int)" by (rule number_of_Min)
   30.29 +  fix w :: bin and x :: bool
   30.30 +  show "(number_of (w BIT x) :: int) =
   30.31 +        (if x then 1 else 0) + number_of w + number_of w"
   30.32 +    by (rule number_of_BIT)
   30.33 +qed
   30.34 +
   30.35 +
   30.36  
   30.37  subsection{*Inequality Reasoning for the Arithmetic Simproc*}
   30.38  
   30.39 +lemma zero_less_nat_eq [simp]: "(0 < nat z) = (0 < z)"
   30.40 +by (cut_tac w = 0 in zless_nat_conj, auto)
   30.41 +
   30.42  lemma zless_imp_add1_zle: "w<z ==> w + (1::int) \<le> z"
   30.43  apply (rule eq_Abs_Integ [of z])
   30.44  apply (rule eq_Abs_Integ [of w])
   30.45 @@ -18,11 +50,115 @@
   30.46  done
   30.47  
   30.48  
   30.49 +
   30.50 +lemma add_numeral_0: "Numeral0 + a = (a::'a::number_ring)"
   30.51 +by simp 
   30.52 +
   30.53 +lemma add_numeral_0_right: "a + Numeral0 = (a::'a::number_ring)"
   30.54 +by simp
   30.55 +
   30.56 +lemma mult_numeral_1: "Numeral1 * a = (a::'a::number_ring)"
   30.57 +by simp 
   30.58 +
   30.59 +lemma mult_numeral_1_right: "a * Numeral1 = (a::'a::number_ring)"
   30.60 +by simp
   30.61 +
   30.62 +text{*Theorem lists for the cancellation simprocs. The use of binary numerals
   30.63 +for 0 and 1 reduces the number of special cases.*}
   30.64 +
   30.65 +lemmas add_0s = add_numeral_0 add_numeral_0_right
   30.66 +lemmas mult_1s = mult_numeral_1 mult_numeral_1_right 
   30.67 +                 mult_minus1 mult_minus1_right
   30.68 +
   30.69 +
   30.70 +subsection{*Special Arithmetic Rules for Abstract 0 and 1*}
   30.71 +
   30.72 +text{*Arithmetic computations are defined for binary literals, which leaves 0
   30.73 +and 1 as special cases. Addition already has rules for 0, but not 1.
   30.74 +Multiplication and unary minus already have rules for both 0 and 1.*}
   30.75 +
   30.76 +
   30.77 +lemma binop_eq: "[|f x y = g x y; x = x'; y = y'|] ==> f x' y' = g x' y'"
   30.78 +by simp
   30.79 +
   30.80 +
   30.81 +lemmas add_number_of_eq = number_of_add [symmetric]
   30.82 +
   30.83 +text{*Allow 1 on either or both sides*}
   30.84 +lemma one_add_one_is_two: "1 + 1 = (2::'a::number_ring)"
   30.85 +by (simp del: numeral_1_eq_1 add: numeral_1_eq_1 [symmetric] add_number_of_eq)
   30.86 +
   30.87 +lemmas add_special =
   30.88 +    one_add_one_is_two
   30.89 +    binop_eq [of "op +", OF add_number_of_eq numeral_1_eq_1 refl, standard]
   30.90 +    binop_eq [of "op +", OF add_number_of_eq refl numeral_1_eq_1, standard]
   30.91 +
   30.92 +text{*Allow 1 on either or both sides (1-1 already simplifies to 0)*}
   30.93 +lemmas diff_special =
   30.94 +    binop_eq [of "op -", OF diff_number_of_eq numeral_1_eq_1 refl, standard]
   30.95 +    binop_eq [of "op -", OF diff_number_of_eq refl numeral_1_eq_1, standard]
   30.96 +
   30.97 +text{*Allow 0 or 1 on either side with a binary numeral on the other*}
   30.98 +lemmas eq_special =
   30.99 +    binop_eq [of "op =", OF eq_number_of_eq numeral_0_eq_0 refl, standard]
  30.100 +    binop_eq [of "op =", OF eq_number_of_eq numeral_1_eq_1 refl, standard]
  30.101 +    binop_eq [of "op =", OF eq_number_of_eq refl numeral_0_eq_0, standard]
  30.102 +    binop_eq [of "op =", OF eq_number_of_eq refl numeral_1_eq_1, standard]
  30.103 +
  30.104 +text{*Allow 0 or 1 on either side with a binary numeral on the other*}
  30.105 +lemmas less_special =
  30.106 +  binop_eq [of "op <", OF less_number_of_eq_neg numeral_0_eq_0 refl, standard]
  30.107 +  binop_eq [of "op <", OF less_number_of_eq_neg numeral_1_eq_1 refl, standard]
  30.108 +  binop_eq [of "op <", OF less_number_of_eq_neg refl numeral_0_eq_0, standard]
  30.109 +  binop_eq [of "op <", OF less_number_of_eq_neg refl numeral_1_eq_1, standard]
  30.110 +
  30.111 +text{*Allow 0 or 1 on either side with a binary numeral on the other*}
  30.112 +lemmas le_special =
  30.113 +    binop_eq [of "op \<le>", OF le_number_of_eq numeral_0_eq_0 refl, standard]
  30.114 +    binop_eq [of "op \<le>", OF le_number_of_eq numeral_1_eq_1 refl, standard]
  30.115 +    binop_eq [of "op \<le>", OF le_number_of_eq refl numeral_0_eq_0, standard]
  30.116 +    binop_eq [of "op \<le>", OF le_number_of_eq refl numeral_1_eq_1, standard]
  30.117 +
  30.118 +lemmas arith_special = 
  30.119 +       add_special diff_special eq_special less_special le_special
  30.120 +
  30.121 +
  30.122  use "int_arith1.ML"
  30.123  setup int_arith_setup
  30.124  
  30.125  
  30.126 -subsection{*More inequality reasoning*}
  30.127 +subsection{*Lemmas About Small Numerals*}
  30.128 +
  30.129 +lemma of_int_m1 [simp]: "of_int -1 = (-1 :: 'a :: number_ring)"
  30.130 +proof -
  30.131 +  have "(of_int -1 :: 'a) = of_int (- 1)" by simp
  30.132 +  also have "... = - of_int 1" by (simp only: of_int_minus)
  30.133 +  also have "... = -1" by simp
  30.134 +  finally show ?thesis .
  30.135 +qed
  30.136 +
  30.137 +lemma abs_minus_one [simp]: "abs (-1) = (1::'a::{ordered_ring,number_ring})"
  30.138 +by (simp add: abs_if)
  30.139 +
  30.140 +lemma of_int_number_of_eq:
  30.141 +     "of_int (number_of v) = (number_of v :: 'a :: number_ring)"
  30.142 +apply (induct v)
  30.143 +apply (simp_all only: number_of of_int_add, simp_all) 
  30.144 +done
  30.145 +
  30.146 +text{*Lemmas for specialist use, NOT as default simprules*}
  30.147 +lemma mult_2: "2 * z = (z+z::'a::number_ring)"
  30.148 +proof -
  30.149 +  have "2*z = (1 + 1)*z" by simp
  30.150 +  also have "... = z+z" by (simp add: left_distrib)
  30.151 +  finally show ?thesis .
  30.152 +qed
  30.153 +
  30.154 +lemma mult_2_right: "z * 2 = (z+z::'a::number_ring)"
  30.155 +by (subst mult_commute, rule mult_2)
  30.156 +
  30.157 +
  30.158 +subsection{*More Inequality Reasoning*}
  30.159  
  30.160  lemma zless_add1_eq: "(w < z + (1::int)) = (w<z | w=z)"
  30.161  by arith
  30.162 @@ -36,9 +172,6 @@
  30.163  lemma zle_add1_eq_le [simp]: "(w < z + 1) = (w\<le>(z::int))"
  30.164  by arith
  30.165  
  30.166 -lemma zadd_left_cancel0 [simp]: "(z = z + w) = (w = (0::int))"
  30.167 -by arith
  30.168 -
  30.169  lemma int_one_le_iff_zero_less: "((1::int) \<le> z) = (0 < z)"
  30.170  by arith
  30.171  
  30.172 @@ -86,7 +219,6 @@
  30.173  apply (auto simp add: nat_less_iff)
  30.174  done
  30.175  
  30.176 -
  30.177  lemma nat_le_eq_zle: "0 < w | 0 \<le> z ==> (nat w \<le> nat z) = (w\<le>z)"
  30.178  by (auto simp add: linorder_not_less [symmetric] zless_nat_conj)
  30.179  
  30.180 @@ -114,6 +246,7 @@
  30.181    with False show ?thesis by simp
  30.182  qed
  30.183  
  30.184 +
  30.185  subsubsection "Induction principles for int"
  30.186  
  30.187                       (* `set:int': dummy construction *)
  30.188 @@ -177,7 +310,7 @@
  30.189    from this le show ?thesis by fast
  30.190  qed
  30.191  
  30.192 -theorem int_less_induct[consumes 1,case_names base step]:
  30.193 +theorem int_less_induct [consumes 1,case_names base step]:
  30.194    assumes less: "(i::int) < k" and
  30.195          base: "P(k - 1)" and
  30.196          step: "\<And>i. \<lbrakk>i < k; P i\<rbrakk> \<Longrightarrow> P(i - 1)"
  30.197 @@ -228,12 +361,7 @@
  30.198  apply (drule mult_cancel_left [THEN iffD1], auto)
  30.199  done
  30.200  
  30.201 -lemma zless_1_zmult: "[| 1 < m; 1 < n |] ==> 1 < m*(n::int)"
  30.202 -apply (rule_tac y = "1*n" in order_less_trans)
  30.203 -apply (rule_tac [2] mult_strict_right_mono)
  30.204 -apply (simp_all (no_asm_simp))
  30.205 -done
  30.206 -
  30.207 +text{*FIXME: tidy*}
  30.208  lemma pos_zmult_eq_1_iff: "0 < (m::int) ==> (m * n = 1) = (m = 1 & n = 1)"
  30.209  apply auto
  30.210  apply (case_tac "m=1")
  30.211 @@ -242,7 +370,7 @@
  30.212  apply (case_tac [5] "n=1", auto)
  30.213  apply (tactic"distinct_subgoals_tac")
  30.214  apply (subgoal_tac "1<m*n", simp)
  30.215 -apply (rule zless_1_zmult, arith)
  30.216 +apply (rule less_1_mult, arith)
  30.217  apply (subgoal_tac "0<n", arith)
  30.218  apply (subgoal_tac "0<m*n")
  30.219  apply (drule zero_less_mult_iff [THEN iffD1], auto)
  30.220 @@ -300,6 +428,7 @@
  30.221  val zle_diff1_eq = thm "zle_diff1_eq";
  30.222  val zle_add1_eq_le = thm "zle_add1_eq_le";
  30.223  val nonneg_eq_int = thm "nonneg_eq_int";
  30.224 +val abs_minus_one = thm "abs_minus_one";
  30.225  val nat_eq_iff = thm "nat_eq_iff";
  30.226  val nat_eq_iff2 = thm "nat_eq_iff2";
  30.227  val nat_less_iff = thm "nat_less_iff";
  30.228 @@ -312,7 +441,6 @@
  30.229  
  30.230  val nat_intermed_int_val = thm "nat_intermed_int_val";
  30.231  val zmult_eq_self_iff = thm "zmult_eq_self_iff";
  30.232 -val zless_1_zmult = thm "zless_1_zmult";
  30.233  val pos_zmult_eq_1_iff = thm "pos_zmult_eq_1_iff";
  30.234  val zmult_eq_1_iff = thm "zmult_eq_1_iff";
  30.235  val nat_add_distrib = thm "nat_add_distrib";
    31.1 --- a/src/HOL/Integ/IntDef.thy	Sat Feb 14 02:06:12 2004 +0100
    31.2 +++ b/src/HOL/Integ/IntDef.thy	Sun Feb 15 10:46:37 2004 +0100
    31.3 @@ -590,26 +590,6 @@
    31.4  apply (auto dest: order_less_trans simp add: order_less_imp_le)
    31.5  done
    31.6  
    31.7 -
    31.8 -
    31.9 -subsection{*Monotonicity of Multiplication*}
   31.10 -
   31.11 -lemma zmult_zle_mono2: "[| i \<le> j;  (0::int) \<le> k |] ==> k*i \<le> k*j"
   31.12 -  by (rule Ring_and_Field.mult_left_mono)
   31.13 -
   31.14 -lemma zmult_zless_cancel2: "(m*k < n*k) = (((0::int) < k & m<n) | (k<0 & n<m))"
   31.15 -  by (rule Ring_and_Field.mult_less_cancel_right)
   31.16 -
   31.17 -lemma zmult_zless_cancel1:
   31.18 -     "(k*m < k*n) = (((0::int) < k & m<n) | (k < 0 & n<m))"
   31.19 -  by (rule Ring_and_Field.mult_less_cancel_left)
   31.20 -
   31.21 -lemma zmult_zle_cancel1:
   31.22 -     "(k*m \<le> k*n) = (((0::int) < k --> m\<le>n) & (k < 0 --> n\<le>m))"
   31.23 -  by (rule Ring_and_Field.mult_le_cancel_left)
   31.24 -
   31.25 -
   31.26 -
   31.27  text{*A case theorem distinguishing non-negative and negative int*}
   31.28  
   31.29  lemma negD: "x<0 ==> \<exists>n. x = - (int (Suc n))"
   31.30 @@ -728,6 +708,8 @@
   31.31  declare of_nat_le_iff [of 0, simplified, simp]
   31.32  declare of_nat_le_iff [of _ 0, simplified, simp]
   31.33  
   31.34 +text{*The ordering on the semiring is necessary to exclude the possibility of
   31.35 +a finite field, which indeed wraps back to zero.*}
   31.36  lemma of_nat_eq_iff [simp]:
   31.37       "(of_nat m = (of_nat n::'a::ordered_semiring)) = (m = n)"
   31.38  by (simp add: order_eq_iff) 
   31.39 @@ -847,6 +829,7 @@
   31.40  declare of_int_less_iff [of 0, simplified, simp]
   31.41  declare of_int_less_iff [of _ 0, simplified, simp]
   31.42  
   31.43 +text{*The ordering on the ring is necessary. See @{text of_nat_eq_iff} above.*}
   31.44  lemma of_int_eq_iff [simp]:
   31.45       "(of_int w = (of_int z::'a::ordered_ring)) = (w = z)"
   31.46  by (simp add: order_eq_iff) 
   31.47 @@ -922,6 +905,14 @@
   31.48    by (rule Ints_cases) auto
   31.49  
   31.50  
   31.51 +(* int (Suc n) = 1 + int n *)
   31.52 +declare int_Suc [simp]
   31.53 +
   31.54 +text{*Simplification of @{term "x-y < 0"}, etc.*}
   31.55 +declare less_iff_diff_less_0 [symmetric, simp]
   31.56 +declare eq_iff_diff_eq_0 [symmetric, simp]
   31.57 +declare le_iff_diff_le_0 [symmetric, simp]
   31.58 +
   31.59  
   31.60  (*Legacy ML bindings, but no longer the structure Int.*)
   31.61  ML
   31.62 @@ -1048,6 +1039,7 @@
   31.63  val Nats_1 = thm "Nats_1";
   31.64  val Nats_add = thm "Nats_add";
   31.65  val Nats_mult = thm "Nats_mult";
   31.66 +val int_eq_of_nat = thm"int_eq_of_nat";
   31.67  val of_int = thm "of_int";
   31.68  val of_int_0 = thm "of_int_0";
   31.69  val of_int_1 = thm "of_int_1";
    32.1 --- a/src/HOL/Integ/IntDiv.thy	Sat Feb 14 02:06:12 2004 +0100
    32.2 +++ b/src/HOL/Integ/IntDiv.thy	Sun Feb 15 10:46:37 2004 +0100
    32.3 @@ -101,7 +101,7 @@
    32.4   prefer 2 apply (simp add: zdiff_zmult_distrib2 zadd_zmult_distrib2)
    32.5  apply (subgoal_tac "b * q' < b * (1 + q) ")
    32.6   prefer 2 apply (simp add: zdiff_zmult_distrib2 zadd_zmult_distrib2)
    32.7 -apply (simp add: zmult_zless_cancel1)
    32.8 +apply (simp add: mult_less_cancel_left)
    32.9  done
   32.10  
   32.11  lemma unique_quotient_lemma_neg:
   32.12 @@ -526,7 +526,7 @@
   32.13        ==> q \<le> (q'::int)"
   32.14  apply (frule q_pos_lemma, assumption+) 
   32.15  apply (subgoal_tac "b*q < b* (q' + 1) ")
   32.16 - apply (simp add: zmult_zless_cancel1)
   32.17 + apply (simp add: mult_less_cancel_left)
   32.18  apply (subgoal_tac "b*q = r' - r + b'*q'")
   32.19   prefer 2 apply simp
   32.20  apply (simp (no_asm_simp) add: zadd_zmult_distrib2)
   32.21 @@ -558,7 +558,7 @@
   32.22        ==> q' \<le> (q::int)"
   32.23  apply (frule q_neg_lemma, assumption+) 
   32.24  apply (subgoal_tac "b*q' < b* (q + 1) ")
   32.25 - apply (simp add: zmult_zless_cancel1)
   32.26 + apply (simp add: mult_less_cancel_left)
   32.27  apply (simp add: zadd_zmult_distrib2)
   32.28  apply (subgoal_tac "b*q' \<le> b'*q'")
   32.29   prefer 2 apply (simp add: mult_right_mono_neg)
   32.30 @@ -725,7 +725,7 @@
   32.31  apply (simp add: zdiff_zmult_distrib2)
   32.32  apply (rule order_less_le_trans)
   32.33  apply (erule mult_strict_right_mono)
   32.34 -apply (rule_tac [2] zmult_zle_mono2)
   32.35 +apply (rule_tac [2] mult_left_mono)
   32.36  apply (auto simp add: compare_rls zadd_commute [of 1]
   32.37                        add1_zle_eq pos_mod_bound)
   32.38  done
   32.39 @@ -904,11 +904,12 @@
   32.40            (if ~b | (0::int) \<le> number_of w                    
   32.41             then number_of v div (number_of w)     
   32.42             else (number_of v + (1::int)) div (number_of w))"
   32.43 -apply (simp only: zadd_assoc number_of_BIT)
   32.44 +apply (simp only: add_assoc number_of_BIT)
   32.45  (*create subgoal because the next step can't simplify numerals*)
   32.46 -apply (subgoal_tac "2 ~= (0::int) ")
   32.47 -apply (simp del: bin_arith_extra_simps 
   32.48 -         add: zdiv_zmult_zmult1 pos_zdiv_mult_2 not_0_le_lemma neg_zdiv_mult_2, simp)
   32.49 +apply (subgoal_tac "2 ~= (0::int) ") 
   32.50 +apply (simp del: bin_arith_extra_simps arith_special
   32.51 +         add: zdiv_zmult_zmult1 pos_zdiv_mult_2 not_0_le_lemma neg_zdiv_mult_2)
   32.52 +apply simp
   32.53  done
   32.54  
   32.55  
   32.56 @@ -922,7 +923,7 @@
   32.57  apply (subgoal_tac "1 < a * 2")
   32.58   prefer 2 apply arith
   32.59  apply (subgoal_tac "2* (1 + b mod a) \<le> 2*a")
   32.60 - apply (rule_tac [2] zmult_zle_mono2)
   32.61 + apply (rule_tac [2] mult_left_mono)
   32.62  apply (auto simp add: zadd_commute [of 1] zmult_commute add1_zle_eq 
   32.63                        pos_mod_bound)
   32.64  apply (subst zmod_zadd1_eq)
   32.65 @@ -953,8 +954,9 @@
   32.66                  else 2 * ((number_of v + (1::int)) mod number_of w) - 1   
   32.67             else 2 * (number_of v mod number_of w))"
   32.68  apply (simp only: zadd_assoc number_of_BIT)
   32.69 -apply (simp del: bin_arith_extra_simps bin_rel_simps 
   32.70 -         add: zmod_zmult_zmult1 pos_zmod_mult_2 not_0_le_lemma neg_zmod_mult_2, simp)
   32.71 +apply (simp del: bin_arith_extra_simps bin_rel_simps arith_special
   32.72 +         add: zmod_zmult_zmult1 pos_zmod_mult_2 not_0_le_lemma neg_zmod_mult_2
   32.73 + neg_def) 
   32.74  done
   32.75  
   32.76  
   32.77 @@ -1114,7 +1116,7 @@
   32.78     apply (blast intro: order_less_trans)
   32.79    apply (simp add: zero_less_mult_iff)
   32.80    apply (subgoal_tac "n * k < n * 1")
   32.81 -   apply (drule zmult_zless_cancel1 [THEN iffD1], auto)
   32.82 +   apply (drule mult_less_cancel_left [THEN iffD1], auto)
   32.83    done
   32.84  
   32.85  lemma int_dvd_iff: "(int m dvd z) = (m dvd nat (abs z))"
    33.1 --- a/src/HOL/Integ/IntDiv_setup.ML	Sat Feb 14 02:06:12 2004 +0100
    33.2 +++ b/src/HOL/Integ/IntDiv_setup.ML	Sun Feb 15 10:46:37 2004 +0100
    33.3 @@ -13,7 +13,7 @@
    33.4  val div_name = "Divides.op div";
    33.5  val mod_name = "Divides.op mod";
    33.6  val mk_binop = HOLogic.mk_binop;
    33.7 -val mk_sum = Int_Numeral_Simprocs.mk_sum;
    33.8 +val mk_sum = Int_Numeral_Simprocs.mk_sum HOLogic.intT;
    33.9  val dest_sum = Int_Numeral_Simprocs.dest_sum;
   33.10  
   33.11  (*logic*)
    34.1 --- a/src/HOL/Integ/NatBin.thy	Sat Feb 14 02:06:12 2004 +0100
    34.2 +++ b/src/HOL/Integ/NatBin.thy	Sun Feb 15 10:46:37 2004 +0100
    34.3 @@ -26,14 +26,14 @@
    34.4  lemma nat_number_of [simp]: "nat (number_of w) = number_of w"
    34.5  by (simp add: nat_number_of_def)
    34.6  
    34.7 -lemma numeral_0_eq_0: "Numeral0 = (0::nat)"
    34.8 +lemma nat_numeral_0_eq_0 [simp]: "Numeral0 = (0::nat)"
    34.9  by (simp add: nat_number_of_def)
   34.10  
   34.11 -lemma numeral_1_eq_1: "Numeral1 = (1::nat)"
   34.12 +lemma nat_numeral_1_eq_1 [simp]: "Numeral1 = (1::nat)"
   34.13  by (simp add: nat_1 nat_number_of_def)
   34.14  
   34.15  lemma numeral_1_eq_Suc_0: "Numeral1 = Suc 0"
   34.16 -by (simp add: numeral_1_eq_1)
   34.17 +by (simp add: nat_numeral_1_eq_1)
   34.18  
   34.19  lemma numeral_2_eq_2: "2 = Suc (Suc 0)"
   34.20  apply (unfold nat_number_of_def)
   34.21 @@ -52,11 +52,11 @@
   34.22  apply (auto elim!: nonneg_eq_int)
   34.23  apply (rename_tac m m')
   34.24  apply (subgoal_tac "0 <= int m div int m'")
   34.25 - prefer 2 apply (simp add: numeral_0_eq_0 pos_imp_zdiv_nonneg_iff) 
   34.26 + prefer 2 apply (simp add: nat_numeral_0_eq_0 pos_imp_zdiv_nonneg_iff) 
   34.27  apply (rule inj_int [THEN injD], simp)
   34.28  apply (rule_tac r = "int (m mod m') " in quorem_div)
   34.29   prefer 2 apply force
   34.30 -apply (simp add: nat_less_iff [symmetric] quorem_def numeral_0_eq_0 zadd_int 
   34.31 +apply (simp add: nat_less_iff [symmetric] quorem_def nat_numeral_0_eq_0 zadd_int 
   34.32                   zmult_int)
   34.33  done
   34.34  
   34.35 @@ -67,24 +67,23 @@
   34.36  apply (auto elim!: nonneg_eq_int)
   34.37  apply (rename_tac m m')
   34.38  apply (subgoal_tac "0 <= int m mod int m'")
   34.39 - prefer 2 apply (simp add: nat_less_iff numeral_0_eq_0 pos_mod_sign) 
   34.40 + prefer 2 apply (simp add: nat_less_iff nat_numeral_0_eq_0 pos_mod_sign) 
   34.41  apply (rule inj_int [THEN injD], simp)
   34.42  apply (rule_tac q = "int (m div m') " in quorem_mod)
   34.43   prefer 2 apply force
   34.44 -apply (simp add: nat_less_iff [symmetric] quorem_def numeral_0_eq_0 zadd_int zmult_int)
   34.45 +apply (simp add: nat_less_iff [symmetric] quorem_def nat_numeral_0_eq_0 zadd_int zmult_int)
   34.46  done
   34.47  
   34.48  
   34.49  subsection{*Function @{term int}: Coercion from Type @{typ nat} to @{typ int}*}
   34.50  
   34.51  (*"neg" is used in rewrite rules for binary comparisons*)
   34.52 -lemma int_nat_number_of:
   34.53 +lemma int_nat_number_of [simp]:
   34.54       "int (number_of v :: nat) =  
   34.55           (if neg (number_of v :: int) then 0  
   34.56            else (number_of v :: int))"
   34.57  by (simp del: nat_number_of
   34.58  	 add: neg_nat nat_number_of_def not_neg_nat add_assoc)
   34.59 -declare int_nat_number_of [simp]
   34.60  
   34.61  
   34.62  (** Successor **)
   34.63 @@ -101,19 +100,18 @@
   34.64           add: nat_number_of_def neg_nat
   34.65                Suc_nat_eq_nat_zadd1 number_of_succ) 
   34.66  
   34.67 -lemma Suc_nat_number_of:
   34.68 +lemma Suc_nat_number_of [simp]:
   34.69       "Suc (number_of v) =  
   34.70          (if neg (number_of v :: int) then 1 else number_of (bin_succ v))"
   34.71  apply (cut_tac n = 0 in Suc_nat_number_of_add)
   34.72  apply (simp cong del: if_weak_cong)
   34.73  done
   34.74 -declare Suc_nat_number_of [simp]
   34.75  
   34.76  
   34.77  (** Addition **)
   34.78  
   34.79  (*"neg" is used in rewrite rules for binary comparisons*)
   34.80 -lemma add_nat_number_of:
   34.81 +lemma add_nat_number_of [simp]:
   34.82       "(number_of v :: nat) + number_of v' =  
   34.83           (if neg (number_of v :: int) then number_of v'  
   34.84            else if neg (number_of v' :: int) then number_of v  
   34.85 @@ -122,8 +120,6 @@
   34.86            simp del: nat_number_of
   34.87            simp add: nat_number_of_def nat_add_distrib [symmetric]) 
   34.88  
   34.89 -declare add_nat_number_of [simp]
   34.90 -
   34.91  
   34.92  (** Subtraction **)
   34.93  
   34.94 @@ -136,31 +132,29 @@
   34.95  apply (simp add: diff_is_0_eq nat_le_eq_zle)
   34.96  done
   34.97  
   34.98 -lemma diff_nat_number_of: 
   34.99 +lemma diff_nat_number_of [simp]: 
  34.100       "(number_of v :: nat) - number_of v' =  
  34.101          (if neg (number_of v' :: int) then number_of v  
  34.102           else let d = number_of (bin_add v (bin_minus v')) in     
  34.103                if neg d then 0 else nat d)"
  34.104  by (simp del: nat_number_of add: diff_nat_eq_if nat_number_of_def) 
  34.105  
  34.106 -declare diff_nat_number_of [simp]
  34.107  
  34.108  
  34.109  (** Multiplication **)
  34.110  
  34.111 -lemma mult_nat_number_of:
  34.112 +lemma mult_nat_number_of [simp]:
  34.113       "(number_of v :: nat) * number_of v' =  
  34.114         (if neg (number_of v :: int) then 0 else number_of (bin_mult v v'))"
  34.115  by (force dest!: neg_nat
  34.116            simp del: nat_number_of
  34.117            simp add: nat_number_of_def nat_mult_distrib [symmetric]) 
  34.118  
  34.119 -declare mult_nat_number_of [simp]
  34.120  
  34.121  
  34.122  (** Quotient **)
  34.123  
  34.124 -lemma div_nat_number_of:
  34.125 +lemma div_nat_number_of [simp]:
  34.126       "(number_of v :: nat)  div  number_of v' =  
  34.127            (if neg (number_of v :: int) then 0  
  34.128             else nat (number_of v div number_of v'))"
  34.129 @@ -168,12 +162,14 @@
  34.130            simp del: nat_number_of
  34.131            simp add: nat_number_of_def nat_div_distrib [symmetric]) 
  34.132  
  34.133 -declare div_nat_number_of [simp]
  34.134 +lemma one_div_nat_number_of [simp]:
  34.135 +     "(Suc 0)  div  number_of v' = (nat (1 div number_of v'))" 
  34.136 +by (simp del: nat_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric]) 
  34.137  
  34.138  
  34.139  (** Remainder **)
  34.140  
  34.141 -lemma mod_nat_number_of:
  34.142 +lemma mod_nat_number_of [simp]:
  34.143       "(number_of v :: nat)  mod  number_of v' =  
  34.144          (if neg (number_of v :: int) then 0  
  34.145           else if neg (number_of v' :: int) then number_of v  
  34.146 @@ -182,15 +178,21 @@
  34.147            simp del: nat_number_of
  34.148            simp add: nat_number_of_def nat_mod_distrib [symmetric]) 
  34.149  
  34.150 -declare mod_nat_number_of [simp]
  34.151 +lemma one_mod_nat_number_of [simp]:
  34.152 +     "(Suc 0)  mod  number_of v' =  
  34.153 +        (if neg (number_of v' :: int) then Suc 0
  34.154 +         else nat (1 mod number_of v'))"
  34.155 +by (simp del: nat_numeral_1_eq_1 add: numeral_1_eq_Suc_0 [symmetric]) 
  34.156 +
  34.157 +
  34.158  
  34.159  ML
  34.160  {*
  34.161  val nat_number_of_def = thm"nat_number_of_def";
  34.162  
  34.163  val nat_number_of = thm"nat_number_of";
  34.164 -val numeral_0_eq_0 = thm"numeral_0_eq_0";
  34.165 -val numeral_1_eq_1 = thm"numeral_1_eq_1";
  34.166 +val nat_numeral_0_eq_0 = thm"nat_numeral_0_eq_0";
  34.167 +val nat_numeral_1_eq_1 = thm"nat_numeral_1_eq_1";
  34.168  val numeral_1_eq_Suc_0 = thm"numeral_1_eq_Suc_0";
  34.169  val numeral_2_eq_2 = thm"numeral_2_eq_2";
  34.170  val nat_div_distrib = thm"nat_div_distrib";
  34.171 @@ -208,29 +210,6 @@
  34.172  *}
  34.173  
  34.174  
  34.175 -ML
  34.176 -{*
  34.177 -structure NatAbstractNumeralsData =
  34.178 -  struct
  34.179 -  val dest_eq		= HOLogic.dest_eq o HOLogic.dest_Trueprop o concl_of
  34.180 -  val is_numeral	= Bin_Simprocs.is_numeral
  34.181 -  val numeral_0_eq_0    = numeral_0_eq_0
  34.182 -  val numeral_1_eq_1    = numeral_1_eq_Suc_0
  34.183 -  val prove_conv        = Bin_Simprocs.prove_conv_nohyps_novars
  34.184 -  fun norm_tac simps	= ALLGOALS (simp_tac (HOL_ss addsimps simps))
  34.185 -  val simplify_meta_eq  = Bin_Simprocs.simplify_meta_eq 
  34.186 -  end;
  34.187 -
  34.188 -structure NatAbstractNumerals = AbstractNumeralsFun (NatAbstractNumeralsData);
  34.189 -
  34.190 -val nat_eval_numerals = 
  34.191 -  map Bin_Simprocs.prep_simproc
  34.192 -   [("nat_div_eval_numerals", ["(Suc 0) div m"], NatAbstractNumerals.proc div_nat_number_of),
  34.193 -    ("nat_mod_eval_numerals", ["(Suc 0) mod m"], NatAbstractNumerals.proc mod_nat_number_of)];
  34.194 -
  34.195 -Addsimprocs nat_eval_numerals;
  34.196 -*}
  34.197 -
  34.198  (*** Comparisons ***)
  34.199  
  34.200  (** Equals (=) **)
  34.201 @@ -270,7 +249,7 @@
  34.202  
  34.203  
  34.204  (*Maps #n to n for n = 0, 1, 2*)
  34.205 -lemmas numerals = numeral_0_eq_0 numeral_1_eq_1 numeral_2_eq_2
  34.206 +lemmas numerals = nat_numeral_0_eq_0 nat_numeral_1_eq_1 numeral_2_eq_2
  34.207  
  34.208  
  34.209  subsection{*General Theorems About Powers Involving Binary Numerals*}
  34.210 @@ -398,7 +377,7 @@
  34.211  lemma eq_number_of_0:
  34.212       "(number_of v = (0::nat)) =  
  34.213        (if neg (number_of v :: int) then True else iszero (number_of v :: int))"
  34.214 -apply (simp add: numeral_0_eq_0 [symmetric] iszero_0)
  34.215 +apply (simp del: nat_numeral_0_eq_0 add: nat_numeral_0_eq_0 [symmetric] iszero_0)
  34.216  done
  34.217  
  34.218  lemma eq_0_number_of:
  34.219 @@ -409,13 +388,13 @@
  34.220  
  34.221  lemma less_0_number_of:
  34.222       "((0::nat) < number_of v) = neg (number_of (bin_minus v) :: int)"
  34.223 -by (simp add: numeral_0_eq_0 [symmetric])
  34.224 +by (simp del: nat_numeral_0_eq_0 add: nat_numeral_0_eq_0 [symmetric])
  34.225  
  34.226  (*Simplification already handles n<0, n<=0 and 0<=n.*)
  34.227  declare eq_number_of_0 [simp] eq_0_number_of [simp] less_0_number_of [simp]
  34.228  
  34.229  lemma neg_imp_number_of_eq_0: "neg (number_of v :: int) ==> number_of v = (0::nat)"
  34.230 -by (simp add: numeral_0_eq_0 [symmetric] iszero_0)
  34.231 +by (simp del: nat_numeral_0_eq_0 add: nat_numeral_0_eq_0 [symmetric] iszero_0)
  34.232  
  34.233  
  34.234  
  34.235 @@ -563,7 +542,7 @@
  34.236             then (let w = z ^ (number_of w) in  z*w*w)    
  34.237             else 1)"
  34.238  apply (simp del: nat_number_of  add: nat_number_of_def number_of_BIT Let_def)
  34.239 -apply (simp only: number_of_add int_numeral_1_eq_1 not_neg_eq_ge_0 neg_eq_less_0) 
  34.240 +apply (simp only: number_of_add nat_numeral_1_eq_1 not_neg_eq_ge_0 neg_eq_less_0) 
  34.241  apply (rule_tac x = "number_of w" in spec, clarify)
  34.242  apply (auto simp add: nat_add_distrib nat_mult_distrib zpower_even power2_eq_square neg_nat)
  34.243  done
    35.1 --- a/src/HOL/Integ/NatSimprocs.thy	Sat Feb 14 02:06:12 2004 +0100
    35.2 +++ b/src/HOL/Integ/NatSimprocs.thy	Sun Feb 15 10:46:37 2004 +0100
    35.3 @@ -31,8 +31,10 @@
    35.4  lemma Suc_diff_number_of:
    35.5       "neg (number_of (bin_minus v)::int) ==>  
    35.6        Suc m - (number_of v) = m - (number_of (bin_pred v))"
    35.7 -apply (subst Suc_diff_eq_diff_pred, simp, simp)
    35.8 -apply (force simp only: diff_nat_number_of less_0_number_of [symmetric] 
    35.9 +apply (subst Suc_diff_eq_diff_pred)
   35.10 +apply (simp add: ); 
   35.11 +apply (simp del: nat_numeral_1_eq_1); 
   35.12 +apply (auto simp only: diff_nat_number_of less_0_number_of [symmetric] 
   35.13                          neg_number_of_bin_pred_iff_0)
   35.14  done
   35.15  
   35.16 @@ -54,7 +56,8 @@
   35.17           if neg pv then nat_case a f n else f (nat pv + n))"
   35.18  apply (subst add_eq_if)
   35.19  apply (simp split add: nat.split
   35.20 -            add: numeral_1_eq_Suc_0 [symmetric] Let_def 
   35.21 +            del: nat_numeral_1_eq_1
   35.22 +	    add: numeral_1_eq_Suc_0 [symmetric] Let_def 
   35.23                   neg_imp_number_of_eq_0 neg_number_of_bin_pred_iff_0)
   35.24  done
   35.25  
   35.26 @@ -74,6 +77,7 @@
   35.27                     else f (nat pv + n) (nat_rec a f (nat pv + n)))"
   35.28  apply (subst add_eq_if)
   35.29  apply (simp split add: nat.split
   35.30 +            del: nat_numeral_1_eq_1
   35.31              add: numeral_1_eq_Suc_0 [symmetric] Let_def neg_imp_number_of_eq_0
   35.32                   neg_number_of_bin_pred_iff_0)
   35.33  done
   35.34 @@ -106,8 +110,6 @@
   35.35  lemma add_2_eq_Suc' [simp]: "n + 2 = Suc (Suc n)"
   35.36  by simp
   35.37  
   35.38 -declare numeral_0_eq_0 [simp] numeral_1_eq_1 [simp] 
   35.39 -
   35.40  text{*Can be used to eliminate long strings of Sucs, but not by default*}
   35.41  lemma Suc3_eq_add_3: "Suc (Suc (Suc n)) = 3 + n"
   35.42  by simp
   35.43 @@ -194,4 +196,20 @@
   35.44  declare divide_eq_eq [of _ "number_of w", standard, simp]
   35.45  
   35.46  
   35.47 +subsubsection{*Division By @{term "-1"}*}
   35.48 +
   35.49 +lemma divide_minus1 [simp]:
   35.50 +     "x/-1 = -(x::'a::{field,division_by_zero,number_ring})" 
   35.51 +by simp
   35.52 +
   35.53 +lemma minus1_divide [simp]:
   35.54 +     "-1 / (x::'a::{field,division_by_zero,number_ring}) = - (1/x)"
   35.55 +by (simp add: divide_inverse_zero inverse_minus_eq)
   35.56 +
   35.57 +ML
   35.58 +{*
   35.59 +val divide_minus1 = thm "divide_minus1";
   35.60 +val minus1_divide = thm "minus1_divide";
   35.61 +*}
   35.62 +
   35.63  end
    36.1 --- a/src/HOL/Integ/int_arith1.ML	Sat Feb 14 02:06:12 2004 +0100
    36.2 +++ b/src/HOL/Integ/int_arith1.ML	Sun Feb 15 10:46:37 2004 +0100
    36.3 @@ -30,11 +30,7 @@
    36.4  
    36.5  val neg_def = thm "neg_def";
    36.6  val iszero_def = thm "iszero_def";
    36.7 -val not_neg_int = thm "not_neg_int";
    36.8 -val neg_zminus_int = thm "neg_zminus_int";
    36.9  
   36.10 -val zadd_ac = thms "Ring_and_Field.add_ac"
   36.11 -val zmult_ac = thms "Ring_and_Field.mult_ac"
   36.12  val NCons_Pls_0 = thm"NCons_Pls_0";
   36.13  val NCons_Pls_1 = thm"NCons_Pls_1";
   36.14  val NCons_Min_0 = thm"NCons_Min_0";
   36.15 @@ -61,12 +57,12 @@
   36.16  val diff_number_of_eq = thm"diff_number_of_eq";
   36.17  val number_of_mult = thm"number_of_mult";
   36.18  val double_number_of_BIT = thm"double_number_of_BIT";
   36.19 -val int_numeral_0_eq_0 = thm"int_numeral_0_eq_0";
   36.20 -val int_numeral_1_eq_1 = thm"int_numeral_1_eq_1";
   36.21 -val zmult_minus1 = thm"zmult_minus1";
   36.22 -val zmult_minus1_right = thm"zmult_minus1_right";
   36.23 -val zminus_number_of_zmult = thm"zminus_number_of_zmult";
   36.24 -val zminus_1_eq_m1 = thm"zminus_1_eq_m1";
   36.25 +val numeral_0_eq_0 = thm"numeral_0_eq_0";
   36.26 +val numeral_1_eq_1 = thm"numeral_1_eq_1";
   36.27 +val numeral_m1_eq_minus_1 = thm"numeral_m1_eq_minus_1";
   36.28 +val mult_minus1 = thm"mult_minus1";
   36.29 +val mult_minus1_right = thm"mult_minus1_right";
   36.30 +val minus_number_of_mult = thm"minus_number_of_mult";
   36.31  val zero_less_nat_eq = thm"zero_less_nat_eq";
   36.32  val eq_number_of_eq = thm"eq_number_of_eq";
   36.33  val iszero_number_of_Pls = thm"iszero_number_of_Pls";
   36.34 @@ -75,13 +71,12 @@
   36.35  val iszero_number_of_0 = thm"iszero_number_of_0";
   36.36  val iszero_number_of_1 = thm"iszero_number_of_1";
   36.37  val less_number_of_eq_neg = thm"less_number_of_eq_neg";
   36.38 +val le_number_of_eq = thm"le_number_of_eq";
   36.39  val not_neg_number_of_Pls = thm"not_neg_number_of_Pls";
   36.40  val neg_number_of_Min = thm"neg_number_of_Min";
   36.41  val neg_number_of_BIT = thm"neg_number_of_BIT";
   36.42  val le_number_of_eq_not_less = thm"le_number_of_eq_not_less";
   36.43 -val zabs_number_of = thm"zabs_number_of";
   36.44 -val zabs_0 = thm"zabs_0";
   36.45 -val zabs_1 = thm"zabs_1";
   36.46 +val abs_number_of = thm"abs_number_of";
   36.47  val number_of_reorient = thm"number_of_reorient";
   36.48  val add_number_of_left = thm"add_number_of_left";
   36.49  val mult_number_of_left = thm"mult_number_of_left";
   36.50 @@ -91,7 +86,6 @@
   36.51  val eq_iff_diff_eq_0 = thm"eq_iff_diff_eq_0";
   36.52  val le_iff_diff_le_0 = thm"le_iff_diff_le_0";
   36.53  
   36.54 -val bin_mult_simps = thms"bin_mult_simps";
   36.55  val NCons_simps = thms"NCons_simps";
   36.56  val bin_arith_extra_simps = thms"bin_arith_extra_simps";
   36.57  val bin_arith_simps = thms"bin_arith_simps";
   36.58 @@ -107,6 +101,7 @@
   36.59  val le_add_iff1 = thm"le_add_iff1";
   36.60  val le_add_iff2 = thm"le_add_iff2";
   36.61  
   36.62 +val arith_special = thms"arith_special";
   36.63  
   36.64  structure Bin_Simprocs =
   36.65    struct
   36.66 @@ -128,43 +123,6 @@
   36.67    fun simplify_meta_eq f_number_of_eq f_eq =
   36.68        mk_meta_eq ([f_eq, f_number_of_eq] MRS trans)
   36.69  
   36.70 -  structure IntAbstractNumeralsData =
   36.71 -    struct
   36.72 -    val dest_eq		= HOLogic.dest_eq o HOLogic.dest_Trueprop o concl_of
   36.73 -    val is_numeral	= is_numeral
   36.74 -    val numeral_0_eq_0    = int_numeral_0_eq_0
   36.75 -    val numeral_1_eq_1    = int_numeral_1_eq_1
   36.76 -    val prove_conv	= prove_conv_nohyps_novars
   36.77 -    fun norm_tac simps	= ALLGOALS (simp_tac (HOL_ss addsimps simps))
   36.78 -    val simplify_meta_eq  = simplify_meta_eq 
   36.79 -    end
   36.80 -
   36.81 -  structure IntAbstractNumerals = AbstractNumeralsFun (IntAbstractNumeralsData)
   36.82 -
   36.83 -
   36.84 -  (*For addition, we already have rules for the operand 0.
   36.85 -    Multiplication is omitted because there are already special rules for 
   36.86 -    both 0 and 1 as operands.  Unary minus is trivial, just have - 1 = -1.
   36.87 -    For the others, having three patterns is a compromise between just having
   36.88 -    one (many spurious calls) and having nine (just too many!) *)
   36.89 -  val eval_numerals = 
   36.90 -    map prep_simproc
   36.91 -     [("int_add_eval_numerals",
   36.92 -       ["(m::int) + 1", "(m::int) + number_of v"], 
   36.93 -       IntAbstractNumerals.proc (number_of_add RS sym)),
   36.94 -      ("int_diff_eval_numerals",
   36.95 -       ["(m::int) - 1", "(m::int) - number_of v"], 
   36.96 -       IntAbstractNumerals.proc diff_number_of_eq),
   36.97 -      ("int_eq_eval_numerals",
   36.98 -       ["(m::int) = 0", "(m::int) = 1", "(m::int) = number_of v"], 
   36.99 -       IntAbstractNumerals.proc eq_number_of_eq),
  36.100 -      ("int_less_eval_numerals",
  36.101 -       ["(m::int) < 0", "(m::int) < 1", "(m::int) < number_of v"], 
  36.102 -       IntAbstractNumerals.proc less_number_of_eq_neg),
  36.103 -      ("int_le_eval_numerals",
  36.104 -       ["(m::int) <= 0", "(m::int) <= 1", "(m::int) <= number_of v"],
  36.105 -       IntAbstractNumerals.proc le_number_of_eq_not_less)]
  36.106 -
  36.107    (*reorientation simprules using ==, for the following simproc*)
  36.108    val meta_zero_reorient = zero_reorient RS eq_reflection
  36.109    val meta_one_reorient = one_reorient RS eq_reflection
  36.110 @@ -188,7 +146,7 @@
  36.111    end;
  36.112  
  36.113  
  36.114 -Addsimprocs Bin_Simprocs.eval_numerals;
  36.115 +Addsimps arith_special;
  36.116  Addsimprocs [Bin_Simprocs.reorient_simproc];
  36.117  
  36.118  
  36.119 @@ -197,15 +155,11 @@
  36.120  
  36.121  (*Maps 0 to Numeral0 and 1 to Numeral1 so that arithmetic in simprocs
  36.122    isn't complicated by the abstract 0 and 1.*)
  36.123 -val numeral_syms = [int_numeral_0_eq_0 RS sym, int_numeral_1_eq_1 RS sym];
  36.124 -val numeral_sym_ss = HOL_ss addsimps numeral_syms;
  36.125 -
  36.126 -fun rename_numerals th =
  36.127 -    simplify numeral_sym_ss (Thm.transfer (the_context ()) th);
  36.128 +val numeral_syms = [numeral_0_eq_0 RS sym, numeral_1_eq_1 RS sym];
  36.129  
  36.130  (*Utilities*)
  36.131  
  36.132 -fun mk_numeral n = HOLogic.number_of_const HOLogic.intT $ HOLogic.mk_bin n;
  36.133 +fun mk_numeral T n = HOLogic.number_of_const T $ HOLogic.mk_bin n;
  36.134  
  36.135  (*Decodes a binary INTEGER*)
  36.136  fun dest_numeral (Const("0", _)) = 0
  36.137 @@ -220,21 +174,23 @@
  36.138           handle TERM _ => find_first_numeral (t::past) terms)
  36.139    | find_first_numeral past [] = raise TERM("find_first_numeral", []);
  36.140  
  36.141 -val zero = mk_numeral 0;
  36.142  val mk_plus = HOLogic.mk_binop "op +";
  36.143  
  36.144 -val uminus_const = Const ("uminus", HOLogic.intT --> HOLogic.intT);
  36.145 +fun mk_minus t = 
  36.146 +  let val T = Term.fastype_of t
  36.147 +  in Const ("uminus", T --> T) $ t
  36.148 +  end;
  36.149  
  36.150  (*Thus mk_sum[t] yields t+0; longer sums don't have a trailing zero*)
  36.151 -fun mk_sum []        = zero
  36.152 -  | mk_sum [t,u]     = mk_plus (t, u)
  36.153 -  | mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
  36.154 +fun mk_sum T []        = mk_numeral T 0
  36.155 +  | mk_sum T [t,u]     = mk_plus (t, u)
  36.156 +  | mk_sum T (t :: ts) = mk_plus (t, mk_sum T ts);
  36.157  
  36.158  (*this version ALWAYS includes a trailing zero*)
  36.159 -fun long_mk_sum []        = zero
  36.160 -  | long_mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
  36.161 +fun long_mk_sum T []        = mk_numeral T 0
  36.162 +  | long_mk_sum T (t :: ts) = mk_plus (t, mk_sum T ts);
  36.163  
  36.164 -val dest_plus = HOLogic.dest_bin "op +" HOLogic.intT;
  36.165 +val dest_plus = HOLogic.dest_bin "op +" Term.dummyT;
  36.166  
  36.167  (*decompose additions AND subtractions as a sum*)
  36.168  fun dest_summing (pos, Const ("op +", _) $ t $ u, ts) =
  36.169 @@ -242,22 +198,27 @@
  36.170    | dest_summing (pos, Const ("op -", _) $ t $ u, ts) =
  36.171          dest_summing (pos, t, dest_summing (not pos, u, ts))
  36.172    | dest_summing (pos, t, ts) =
  36.173 -        if pos then t::ts else uminus_const$t :: ts;
  36.174 +        if pos then t::ts else mk_minus t :: ts;
  36.175  
  36.176  fun dest_sum t = dest_summing (true, t, []);
  36.177  
  36.178  val mk_diff = HOLogic.mk_binop "op -";
  36.179 -val dest_diff = HOLogic.dest_bin "op -" HOLogic.intT;
  36.180 +val dest_diff = HOLogic.dest_bin "op -" Term.dummyT;
  36.181  
  36.182 -val one = mk_numeral 1;
  36.183  val mk_times = HOLogic.mk_binop "op *";
  36.184  
  36.185 -fun mk_prod [] = one
  36.186 -  | mk_prod [t] = t
  36.187 -  | mk_prod (t :: ts) = if t = one then mk_prod ts
  36.188 -                        else mk_times (t, mk_prod ts);
  36.189 +fun mk_prod T = 
  36.190 +  let val one = mk_numeral T 1
  36.191 +  fun mk [] = one
  36.192 +    | mk [t] = t
  36.193 +    | mk (t :: ts) = if t = one then mk ts else mk_times (t, mk ts)
  36.194 +  in mk end;
  36.195  
  36.196 -val dest_times = HOLogic.dest_bin "op *" HOLogic.intT;
  36.197 +(*This version ALWAYS includes a trailing one*)
  36.198 +fun long_mk_prod T []        = mk_numeral T 1
  36.199 +  | long_mk_prod T (t :: ts) = mk_times (t, mk_prod T ts);
  36.200 +
  36.201 +val dest_times = HOLogic.dest_bin "op *" Term.dummyT;
  36.202  
  36.203  fun dest_prod t =
  36.204        let val (t,u) = dest_times t
  36.205 @@ -265,7 +226,7 @@
  36.206        handle TERM _ => [t];
  36.207  
  36.208  (*DON'T do the obvious simplifications; that would create special cases*)
  36.209 -fun mk_coeff (k, ts) = mk_times (mk_numeral k, ts);
  36.210 +fun mk_coeff (k, t) = mk_times (mk_numeral (Term.fastype_of t) k, t);
  36.211  
  36.212  (*Express t as a product of (possibly) a numeral with other sorted terms*)
  36.213  fun dest_coeff sign (Const ("uminus", _) $ t) = dest_coeff (~sign) t
  36.214 @@ -273,7 +234,7 @@
  36.215      let val ts = sort Term.term_ord (dest_prod t)
  36.216          val (n, ts') = find_first_numeral [] ts
  36.217                            handle TERM _ => (1, ts)
  36.218 -    in (sign*n, mk_prod ts') end;
  36.219 +    in (sign*n, mk_prod (Term.fastype_of t) ts') end;
  36.220  
  36.221  (*Find first coefficient-term THAT MATCHES u*)
  36.222  fun find_first_coeff past u [] = raise TERM("find_first_coeff", [])
  36.223 @@ -286,13 +247,12 @@
  36.224  
  36.225  
  36.226  (*Simplify Numeral0+n, n+Numeral0, Numeral1*n, n*Numeral1*)
  36.227 -val add_0s =  map rename_numerals [zadd_0, zadd_0_right];
  36.228 -val mult_1s = map rename_numerals [zmult_1, zmult_1_right] @
  36.229 -              [zmult_minus1, zmult_minus1_right];
  36.230 +val add_0s =  thms "add_0s";
  36.231 +val mult_1s = thms "mult_1s";
  36.232  
  36.233  (*To perform binary arithmetic.  The "left" rewriting handles patterns
  36.234    created by the simprocs, such as 3 * (5 * x). *)
  36.235 -val bin_simps = [int_numeral_0_eq_0 RS sym, int_numeral_1_eq_1 RS sym,
  36.236 +val bin_simps = [numeral_0_eq_0 RS sym, numeral_1_eq_1 RS sym,
  36.237                   add_number_of_left, mult_number_of_left] @
  36.238                  bin_arith_simps @ bin_rel_simps;
  36.239  
  36.240 @@ -302,25 +262,25 @@
  36.241      bin_simps \\ [add_number_of_left, number_of_add RS sym];
  36.242  
  36.243  (*To evaluate binary negations of coefficients*)
  36.244 -val zminus_simps = NCons_simps @
  36.245 -                   [zminus_1_eq_m1, number_of_minus RS sym,
  36.246 +val minus_simps = NCons_simps @
  36.247 +                   [numeral_m1_eq_minus_1 RS sym, number_of_minus RS sym,
  36.248                      bin_minus_1, bin_minus_0, bin_minus_Pls, bin_minus_Min,
  36.249                      bin_pred_1, bin_pred_0, bin_pred_Pls, bin_pred_Min];
  36.250  
  36.251  (*To let us treat subtraction as addition*)
  36.252 -val diff_simps = [zdiff_def, zminus_zadd_distrib, zminus_zminus];
  36.253 +val diff_simps = [diff_minus, minus_add_distrib, minus_minus];
  36.254  
  36.255  (*push the unary minus down: - x * y = x * - y *)
  36.256 -val int_minus_mult_eq_1_to_2 =
  36.257 -    [zmult_zminus, zmult_zminus_right RS sym] MRS trans |> standard;
  36.258 +val minus_mult_eq_1_to_2 =
  36.259 +    [minus_mult_left RS sym, minus_mult_right] MRS trans |> standard;
  36.260  
  36.261  (*to extract again any uncancelled minuses*)
  36.262 -val int_minus_from_mult_simps =
  36.263 -    [zminus_zminus, zmult_zminus, zmult_zminus_right];
  36.264 +val minus_from_mult_simps =
  36.265 +    [minus_minus, minus_mult_left RS sym, minus_mult_right RS sym];
  36.266  
  36.267  (*combine unary minus with numeric literals, however nested within a product*)
  36.268 -val int_mult_minus_simps =
  36.269 -    [zmult_assoc, zmult_zminus RS sym, int_minus_mult_eq_1_to_2];
  36.270 +val mult_minus_simps =
  36.271 +    [mult_assoc, minus_mult_left, minus_mult_eq_1_to_2];
  36.272  
  36.273  (*Apply the given rewrite (if present) just once*)
  36.274  fun trans_tac None      = all_tac
  36.275 @@ -340,10 +300,10 @@
  36.276    val trans_tac         = trans_tac
  36.277    val norm_tac =
  36.278       ALLGOALS (simp_tac (HOL_ss addsimps numeral_syms@add_0s@mult_1s@
  36.279 -                                         diff_simps@zminus_simps@zadd_ac))
  36.280 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps non_add_bin_simps@int_mult_minus_simps))
  36.281 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps int_minus_from_mult_simps@
  36.282 -                                              zadd_ac@zmult_ac))
  36.283 +                                         diff_simps@minus_simps@add_ac))
  36.284 +     THEN ALLGOALS (simp_tac (HOL_ss addsimps non_add_bin_simps@mult_minus_simps))
  36.285 +     THEN ALLGOALS (simp_tac (HOL_ss addsimps minus_from_mult_simps@
  36.286 +                                              add_ac@mult_ac))
  36.287    val numeral_simp_tac  = ALLGOALS (simp_tac (HOL_ss addsimps add_0s@bin_simps))
  36.288    val simplify_meta_eq  = simplify_meta_eq (add_0s@mult_1s)
  36.289    end;
  36.290 @@ -353,7 +313,7 @@
  36.291   (open CancelNumeralsCommon
  36.292    val prove_conv = Bin_Simprocs.prove_conv
  36.293    val mk_bal   = HOLogic.mk_eq
  36.294 -  val dest_bal = HOLogic.dest_bin "op =" HOLogic.intT
  36.295 +  val dest_bal = HOLogic.dest_bin "op =" Term.dummyT
  36.296    val bal_add1 = eq_add_iff1 RS trans
  36.297    val bal_add2 = eq_add_iff2 RS trans
  36.298  );
  36.299 @@ -362,7 +322,7 @@
  36.300   (open CancelNumeralsCommon
  36.301    val prove_conv = Bin_Simprocs.prove_conv
  36.302    val mk_bal   = HOLogic.mk_binrel "op <"
  36.303 -  val dest_bal = HOLogic.dest_bin "op <" HOLogic.intT
  36.304 +  val dest_bal = HOLogic.dest_bin "op <" Term.dummyT
  36.305    val bal_add1 = less_add_iff1 RS trans
  36.306    val bal_add2 = less_add_iff2 RS trans
  36.307  );
  36.308 @@ -371,7 +331,7 @@
  36.309   (open CancelNumeralsCommon
  36.310    val prove_conv = Bin_Simprocs.prove_conv
  36.311    val mk_bal   = HOLogic.mk_binrel "op <="
  36.312 -  val dest_bal = HOLogic.dest_bin "op <=" HOLogic.intT
  36.313 +  val dest_bal = HOLogic.dest_bin "op <=" Term.dummyT
  36.314    val bal_add1 = le_add_iff1 RS trans
  36.315    val bal_add2 = le_add_iff2 RS trans
  36.316  );
  36.317 @@ -379,19 +339,28 @@
  36.318  val cancel_numerals =
  36.319    map Bin_Simprocs.prep_simproc
  36.320     [("inteq_cancel_numerals",
  36.321 -     ["(l::int) + m = n", "(l::int) = m + n",
  36.322 -      "(l::int) - m = n", "(l::int) = m - n",
  36.323 -      "(l::int) * m = n", "(l::int) = m * n"],
  36.324 +     ["(l::'a::number_ring) + m = n",
  36.325 +      "(l::'a::number_ring) = m + n",
  36.326 +      "(l::'a::number_ring) - m = n",
  36.327 +      "(l::'a::number_ring) = m - n",
  36.328 +      "(l::'a::number_ring) * m = n",
  36.329 +      "(l::'a::number_ring) = m * n"],
  36.330       EqCancelNumerals.proc),
  36.331      ("intless_cancel_numerals",
  36.332 -     ["(l::int) + m < n", "(l::int) < m + n",
  36.333 -      "(l::int) - m < n", "(l::int) < m - n",
  36.334 -      "(l::int) * m < n", "(l::int) < m * n"],
  36.335 +     ["(l::'a::{ordered_ring,number_ring}) + m < n",
  36.336 +      "(l::'a::{ordered_ring,number_ring}) < m + n",
  36.337 +      "(l::'a::{ordered_ring,number_ring}) - m < n",
  36.338 +      "(l::'a::{ordered_ring,number_ring}) < m - n",
  36.339 +      "(l::'a::{ordered_ring,number_ring}) * m < n",
  36.340 +      "(l::'a::{ordered_ring,number_ring}) < m * n"],
  36.341       LessCancelNumerals.proc),
  36.342      ("intle_cancel_numerals",
  36.343 -     ["(l::int) + m <= n", "(l::int) <= m + n",
  36.344 -      "(l::int) - m <= n", "(l::int) <= m - n",
  36.345 -      "(l::int) * m <= n", "(l::int) <= m * n"],
  36.346 +     ["(l::'a::{ordered_ring,number_ring}) + m <= n",
  36.347 +      "(l::'a::{ordered_ring,number_ring}) <= m + n",
  36.348 +      "(l::'a::{ordered_ring,number_ring}) - m <= n",
  36.349 +      "(l::'a::{ordered_ring,number_ring}) <= m - n",
  36.350 +      "(l::'a::{ordered_ring,number_ring}) * m <= n",
  36.351 +      "(l::'a::{ordered_ring,number_ring}) <= m * n"],
  36.352       LeCancelNumerals.proc)];
  36.353  
  36.354  
  36.355 @@ -407,10 +376,10 @@
  36.356    val trans_tac          = trans_tac
  36.357    val norm_tac =
  36.358       ALLGOALS (simp_tac (HOL_ss addsimps numeral_syms@add_0s@mult_1s@
  36.359 -                                         diff_simps@zminus_simps@zadd_ac))
  36.360 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps non_add_bin_simps@int_mult_minus_simps))
  36.361 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps int_minus_from_mult_simps@
  36.362 -                                              zadd_ac@zmult_ac))
  36.363 +                                         diff_simps@minus_simps@add_ac))
  36.364 +     THEN ALLGOALS (simp_tac (HOL_ss addsimps non_add_bin_simps@mult_minus_simps))
  36.365 +     THEN ALLGOALS (simp_tac (HOL_ss addsimps minus_from_mult_simps@
  36.366 +                                              add_ac@mult_ac))
  36.367    val numeral_simp_tac  = ALLGOALS
  36.368                      (simp_tac (HOL_ss addsimps add_0s@bin_simps))
  36.369    val simplify_meta_eq  = simplify_meta_eq (add_0s@mult_1s)
  36.370 @@ -420,7 +389,9 @@
  36.371  
  36.372  val combine_numerals =
  36.373    Bin_Simprocs.prep_simproc
  36.374 -    ("int_combine_numerals", ["(i::int) + j", "(i::int) - j"], CombineNumerals.proc);
  36.375 +    ("int_combine_numerals", 
  36.376 +     ["(i::'a::number_ring) + j", "(i::'a::number_ring) - j"], 
  36.377 +     CombineNumerals.proc);
  36.378  
  36.379  end;
  36.380  
  36.381 @@ -465,43 +436,28 @@
  36.382  *)
  36.383  
  36.384  
  36.385 -(** Constant folding for integer plus and times **)
  36.386 +(** Constant folding for multiplication in semirings **)
  36.387  
  36.388 -(*We do not need
  36.389 -    structure Nat_Plus_Assoc = Assoc_Fold (Nat_Plus_Assoc_Data);
  36.390 -    structure Int_Plus_Assoc = Assoc_Fold (Int_Plus_Assoc_Data);
  36.391 -  because combine_numerals does the same thing*)
  36.392 +(*We do not need folding for addition: combine_numerals does the same thing*)
  36.393  
  36.394 -structure Int_Times_Assoc_Data : ASSOC_FOLD_DATA =
  36.395 +structure Semiring_Times_Assoc_Data : ASSOC_FOLD_DATA =
  36.396  struct
  36.397    val ss                = HOL_ss
  36.398    val eq_reflection     = eq_reflection
  36.399    val sg_ref = Sign.self_ref (Theory.sign_of (the_context ()))
  36.400 -  val T      = HOLogic.intT
  36.401 -  val plus   = Const ("op *", [HOLogic.intT,HOLogic.intT] ---> HOLogic.intT);
  36.402 -  val add_ac = zmult_ac
  36.403 -end;
  36.404 -
  36.405 -structure Int_Times_Assoc = Assoc_Fold (Int_Times_Assoc_Data);
  36.406 -
  36.407 -Addsimprocs [Int_Times_Assoc.conv];
  36.408 -
  36.409 -
  36.410 -(** The same for the naturals **)
  36.411 -
  36.412 -structure Nat_Times_Assoc_Data : ASSOC_FOLD_DATA =
  36.413 -struct
  36.414 -  val ss                = HOL_ss
  36.415 -  val eq_reflection     = eq_reflection
  36.416 -  val sg_ref = Sign.self_ref (Theory.sign_of (the_context ()))
  36.417 -  val T      = HOLogic.natT
  36.418 -  val plus   = Const ("op *", [HOLogic.natT,HOLogic.natT] ---> HOLogic.natT);
  36.419    val add_ac = mult_ac
  36.420  end;
  36.421  
  36.422 -structure Nat_Times_Assoc = Assoc_Fold (Nat_Times_Assoc_Data);
  36.423 +structure Semiring_Times_Assoc = Assoc_Fold (Semiring_Times_Assoc_Data);
  36.424  
  36.425 -Addsimprocs [Nat_Times_Assoc.conv];
  36.426 +val assoc_fold_simproc =
  36.427 +  Bin_Simprocs.prep_simproc
  36.428 +   ("semiring_assoc_fold", ["(a::'a::semiring) * b"],
  36.429 +    Semiring_Times_Assoc.proc);
  36.430 +
  36.431 +Addsimprocs [assoc_fold_simproc];
  36.432 +
  36.433 +
  36.434  
  36.435  
  36.436  (*** decision procedure for linear arithmetic ***)
  36.437 @@ -519,18 +475,19 @@
  36.438  
  36.439  (* reduce contradictory <= to False *)
  36.440  val add_rules =
  36.441 -    simp_thms @ bin_arith_simps @ bin_rel_simps @
  36.442 -    [int_numeral_0_eq_0, int_numeral_1_eq_1,
  36.443 +    simp_thms @ bin_arith_simps @ bin_rel_simps @ arith_special @
  36.444 +    [numeral_0_eq_0, numeral_1_eq_1,
  36.445       minus_zero, diff_minus, left_minus, right_minus,
  36.446       mult_zero_left, mult_zero_right, mult_1, mult_1_right,
  36.447       minus_mult_left RS sym, minus_mult_right RS sym,
  36.448       minus_add_distrib, minus_minus, mult_assoc,
  36.449 -     int_0, int_1, int_Suc, zadd_int RS sym, zmult_int RS sym,
  36.450 -     le_number_of_eq_not_less];
  36.451 +     of_nat_0, of_nat_1, of_nat_Suc, of_nat_add, of_nat_mult,
  36.452 +     of_int_0, of_int_1, of_int_add, of_int_mult, int_eq_of_nat,
  36.453 +     zero_neq_one, zero_less_one, zero_le_one, 
  36.454 +     zero_neq_one RS not_sym, not_one_le_zero, not_one_less_zero];
  36.455  
  36.456 -val simprocs = [Int_Times_Assoc.conv, Int_Numeral_Simprocs.combine_numerals]@
  36.457 -               Int_Numeral_Simprocs.cancel_numerals @
  36.458 -               Bin_Simprocs.eval_numerals;
  36.459 +val simprocs = [assoc_fold_simproc, Int_Numeral_Simprocs.combine_numerals]@
  36.460 +               Int_Numeral_Simprocs.cancel_numerals;
  36.461  
  36.462  in
  36.463  
  36.464 @@ -543,6 +500,7 @@
  36.465      simpset = simpset addsimps add_rules
  36.466                        addsimprocs simprocs
  36.467                        addcongs [if_weak_cong]}),
  36.468 +  arith_inj_const ("IntDef.of_nat", HOLogic.natT --> HOLogic.intT),
  36.469    arith_inj_const ("IntDef.int", HOLogic.natT --> HOLogic.intT),
  36.470    arith_discrete ("IntDef.int", true)];
  36.471  
  36.472 @@ -550,7 +508,10 @@
  36.473  
  36.474  val fast_int_arith_simproc =
  36.475    Simplifier.simproc (Theory.sign_of (the_context()))
  36.476 -  "fast_int_arith" ["(m::int) < n","(m::int) <= n", "(m::int) = n"] Fast_Arith.lin_arith_prover;
  36.477 +  "fast_int_arith" 
  36.478 +     ["(m::'a::{ordered_ring,number_ring}) < n",
  36.479 +      "(m::'a::{ordered_ring,number_ring}) <= n",
  36.480 +      "(m::'a::{ordered_ring,number_ring}) = n"] Fast_Arith.lin_arith_prover;
  36.481  
  36.482  Addsimprocs [fast_int_arith_simproc]
  36.483  
    37.1 --- a/src/HOL/Integ/int_factor_simprocs.ML	Sat Feb 14 02:06:12 2004 +0100
    37.2 +++ b/src/HOL/Integ/int_factor_simprocs.ML	Sun Feb 15 10:46:37 2004 +0100
    37.3 @@ -31,9 +31,9 @@
    37.4    val dest_coeff        = dest_coeff 1
    37.5    val trans_tac         = trans_tac
    37.6    val norm_tac =
    37.7 -     ALLGOALS (simp_tac (HOL_ss addsimps int_minus_from_mult_simps@mult_1s))
    37.8 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps bin_simps@int_mult_minus_simps))
    37.9 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps zmult_ac))
   37.10 +     ALLGOALS (simp_tac (HOL_ss addsimps minus_from_mult_simps@mult_1s))
   37.11 +     THEN ALLGOALS (simp_tac (HOL_ss addsimps bin_simps@mult_minus_simps))
   37.12 +     THEN ALLGOALS (simp_tac (HOL_ss addsimps mult_ac))
   37.13    val numeral_simp_tac  = ALLGOALS (simp_tac (HOL_ss addsimps bin_simps))
   37.14    val simplify_meta_eq  = simplify_meta_eq mult_1s
   37.15    end
   37.16 @@ -132,11 +132,6 @@
   37.17    open Int_Numeral_Simprocs
   37.18  in
   37.19  
   37.20 -
   37.21 -(*this version ALWAYS includes a trailing one*)
   37.22 -fun long_mk_prod []        = one
   37.23 -  | long_mk_prod (t :: ts) = mk_times (t, mk_prod ts);
   37.24 -
   37.25  (*Find first term that matches u*)
   37.26  fun find_first past u []         = raise TERM("find_first", [])
   37.27    | find_first past u (t::terms) =
   37.28 @@ -147,7 +142,7 @@
   37.29  (*Final simplification: cancel + and *  *)
   37.30  fun cancel_simplify_meta_eq cancel_th th =
   37.31      Int_Numeral_Simprocs.simplify_meta_eq
   37.32 -        [zmult_1, zmult_1_right]
   37.33 +        [mult_1, mult_1_right]
   37.34          (([th, cancel_th]) MRS trans);
   37.35  
   37.36  structure CancelFactorCommon =
   37.37 @@ -158,9 +153,11 @@
   37.38    val dest_coeff        = dest_coeff
   37.39    val find_first        = find_first []
   37.40    val trans_tac         = trans_tac
   37.41 -  val norm_tac = ALLGOALS (simp_tac (HOL_ss addsimps mult_1s@zmult_ac))
   37.42 +  val norm_tac = ALLGOALS (simp_tac (HOL_ss addsimps mult_1s@mult_ac))
   37.43    end;
   37.44  
   37.45 +(*mult_cancel_left requires an ordered ring, such as int. The version in
   37.46 +  rat_arith.ML works for all fields.*)
   37.47  structure EqCancelFactor = ExtractCommonTermFun
   37.48   (open CancelFactorCommon
   37.49    val prove_conv = Bin_Simprocs.prove_conv
   37.50 @@ -169,6 +166,8 @@
   37.51    val simplify_meta_eq  = cancel_simplify_meta_eq mult_cancel_left
   37.52  );
   37.53  
   37.54 +(*int_mult_div_cancel_disj is for integer division (div). The version in
   37.55 +  rat_arith.ML works for all fields, using real division (/).*)
   37.56  structure DivideCancelFactor = ExtractCommonTermFun
   37.57   (open CancelFactorCommon
   37.58    val prove_conv = Bin_Simprocs.prove_conv
    38.1 --- a/src/HOL/Integ/nat_simprocs.ML	Sat Feb 14 02:06:12 2004 +0100
    38.2 +++ b/src/HOL/Integ/nat_simprocs.ML	Sun Feb 15 10:46:37 2004 +0100
    38.3 @@ -11,7 +11,7 @@
    38.4  
    38.5  (*Maps n to #n for n = 0, 1, 2*)
    38.6  val numeral_syms =
    38.7 -       [numeral_0_eq_0 RS sym, numeral_1_eq_1 RS sym, numeral_2_eq_2 RS sym];
    38.8 +       [nat_numeral_0_eq_0 RS sym, nat_numeral_1_eq_1 RS sym, numeral_2_eq_2 RS sym];
    38.9  val numeral_sym_ss = HOL_ss addsimps numeral_syms;
   38.10  
   38.11  fun rename_numerals th =
   38.12 @@ -65,7 +65,7 @@
   38.13  
   38.14  val trans_tac = Int_Numeral_Simprocs.trans_tac;
   38.15  
   38.16 -val bin_simps = [numeral_0_eq_0 RS sym, numeral_1_eq_1 RS sym,
   38.17 +val bin_simps = [nat_numeral_0_eq_0 RS sym, nat_numeral_1_eq_1 RS sym,
   38.18                   add_nat_number_of, nat_number_of_add_left,
   38.19                   diff_nat_number_of, le_number_of_eq_not_less,
   38.20                   less_nat_number_of, mult_nat_number_of,
   38.21 @@ -126,7 +126,7 @@
   38.22  
   38.23  val simplify_meta_eq =
   38.24      Int_Numeral_Simprocs.simplify_meta_eq
   38.25 -        ([numeral_0_eq_0, numeral_1_eq_Suc_0, add_0, add_0_right,
   38.26 +        ([nat_numeral_0_eq_0, numeral_1_eq_Suc_0, add_0, add_0_right,
   38.27            mult_0, mult_0_right, mult_1, mult_1_right] @ contra_rules);
   38.28  
   38.29  
   38.30 @@ -153,7 +153,7 @@
   38.31  
   38.32  structure CancelNumeralsCommon =
   38.33    struct
   38.34 -  val mk_sum            = mk_sum
   38.35 +  val mk_sum            = (fn T:typ => mk_sum)
   38.36    val dest_sum          = dest_Sucs_sum
   38.37    val mk_coeff          = mk_coeff
   38.38    val dest_coeff        = dest_coeff
   38.39 @@ -236,7 +236,7 @@
   38.40  structure CombineNumeralsData =
   38.41    struct
   38.42    val add               = op + : int*int -> int
   38.43 -  val mk_sum            = long_mk_sum    (*to work for e.g. 2*x + 3*x *)
   38.44 +  val mk_sum            = (fn T:typ => long_mk_sum)  (*to work for 2*x + 3*x *)
   38.45    val dest_sum          = restricted_dest_Sucs_sum
   38.46    val mk_coeff          = mk_coeff
   38.47    val dest_coeff        = dest_coeff
   38.48 @@ -346,7 +346,7 @@
   38.49  
   38.50  structure CancelFactorCommon =
   38.51    struct
   38.52 -  val mk_sum            = long_mk_prod
   38.53 +  val mk_sum            = (fn T:typ => long_mk_prod)
   38.54    val dest_sum          = dest_prod
   38.55    val mk_coeff          = mk_coeff
   38.56    val dest_coeff        = dest_coeff
   38.57 @@ -514,8 +514,7 @@
   38.58     eq_number_of_0, eq_0_number_of, less_0_number_of,
   38.59     nat_number_of, if_True, if_False];
   38.60  
   38.61 -val simprocs = [Nat_Times_Assoc.conv,
   38.62 -                Nat_Numeral_Simprocs.combine_numerals]@
   38.63 +val simprocs = [Nat_Numeral_Simprocs.combine_numerals]@
   38.64                  Nat_Numeral_Simprocs.cancel_numerals;
   38.65  
   38.66  in
    39.1 --- a/src/HOL/IsaMakefile	Sat Feb 14 02:06:12 2004 +0100
    39.2 +++ b/src/HOL/IsaMakefile	Sun Feb 15 10:46:37 2004 +0100
    39.3 @@ -138,10 +138,9 @@
    39.4  
    39.5  $(OUT)/HOL-Complex: $(OUT)/HOL Complex/ROOT.ML\
    39.6    Library/Zorn.thy\
    39.7 -  Real/Lubs.thy Real/rat_arith.ML Real/RatArith.thy\
    39.8 +  Real/Lubs.thy Real/rat_arith.ML\
    39.9    Real/Rational.thy Real/PReal.thy Real/RComplete.thy \
   39.10 -  Real/ROOT.ML Real/Real.thy \
   39.11 -  Real/RealArith.thy Real/real_arith.ML Real/RealDef.thy \
   39.12 +  Real/ROOT.ML Real/Real.thy Real/real_arith.ML Real/RealDef.thy \
   39.13    Real/RealPow.thy Real/document/root.tex Real/real_arith.ML\
   39.14    Hyperreal/EvenOdd.ML Hyperreal/EvenOdd.thy \
   39.15    Hyperreal/Fact.ML Hyperreal/Fact.thy\
   39.16 @@ -161,13 +160,9 @@
   39.17    Complex/Complex_Main.thy\
   39.18    Complex/CLim.ML Complex/CLim.thy\
   39.19    Complex/CSeries.ML Complex/CSeries.thy\
   39.20 -  Complex/CStar.ML Complex/CStar.thy Complex/Complex.thy\
   39.21 -  Complex/ComplexArith0.ML Complex/ComplexArith0.thy\
   39.22 -  Complex/ComplexBin.ML Complex/ComplexBin.thy\
   39.23 +  Complex/CStar.ML Complex/CStar.thy Complex/Complex.thy Complex/ComplexBin.thy\
   39.24    Complex/NSCA.ML Complex/NSCA.thy\
   39.25 -  Complex/NSComplex.thy\
   39.26 -  Complex/hcomplex_arith.ML Complex/NSComplexArith.thy\
   39.27 -  Complex/NSComplexBin.ML Complex/NSComplexBin.thy
   39.28 +  Complex/NSComplex.thy
   39.29  	@cd Complex; $(ISATOOL) usedir -b $(OUT)/HOL HOL-Complex
   39.30  
   39.31  
    40.1 --- a/src/HOL/NumberTheory/Int2.thy	Sat Feb 14 02:06:12 2004 +0100
    40.2 +++ b/src/HOL/NumberTheory/Int2.thy	Sun Feb 15 10:46:37 2004 +0100
    40.3 @@ -62,7 +62,7 @@
    40.4      by (auto simp add: zmod_zdiv_equality [THEN sym] zmult_ac)
    40.5    also assume  "x < y * z";
    40.6    finally show ?thesis;
    40.7 -    by (auto simp add: prems zmult_zless_cancel2, insert prems, arith)
    40.8 +    by (auto simp add: prems mult_less_cancel_right, insert prems, arith)
    40.9  qed;
   40.10  
   40.11  lemma div_prop2: "[| 0 < z; (x::int) < (y * z) + z |] ==> x div z \<le> y";
    41.1 --- a/src/HOL/NumberTheory/IntPrimes.thy	Sat Feb 14 02:06:12 2004 +0100
    41.2 +++ b/src/HOL/NumberTheory/IntPrimes.thy	Sun Feb 15 10:46:37 2004 +0100
    41.3 @@ -124,8 +124,8 @@
    41.4    -- {* addition is an AC-operator *}
    41.5  
    41.6  lemma zgcd_zmult_distrib2: "0 \<le> k ==> k * zgcd (m, n) = zgcd (k * m, k * n)"
    41.7 -  by (simp del: zmult_zminus_right
    41.8 -      add: zmult_zminus_right [symmetric] nat_mult_distrib zgcd_def zabs_def
    41.9 +  by (simp del: minus_mult_right [symmetric]
   41.10 +      add: minus_mult_right nat_mult_distrib zgcd_def zabs_def
   41.11            mult_less_0_iff gcd_mult_distrib2 [symmetric] zmult_int [symmetric])
   41.12  
   41.13  lemma zgcd_zmult_distrib2_abs: "zgcd (k * m, k * n) = abs k * zgcd (m, n)"
   41.14 @@ -365,7 +365,7 @@
   41.15    apply (subgoal_tac "0 < m")
   41.16     apply (simp add: zero_le_mult_iff)
   41.17     apply (subgoal_tac "m * k < m * 1")
   41.18 -    apply (drule zmult_zless_cancel1 [THEN iffD1])
   41.19 +    apply (drule mult_less_cancel_left [THEN iffD1])
   41.20      apply (auto simp add: linorder_neq_iff)
   41.21    done
   41.22  
    42.1 --- a/src/HOL/NumberTheory/Quadratic_Reciprocity.thy	Sat Feb 14 02:06:12 2004 +0100
    42.2 +++ b/src/HOL/NumberTheory/Quadratic_Reciprocity.thy	Sun Feb 15 10:46:37 2004 +0100
    42.3 @@ -320,7 +320,7 @@
    42.4    proof -;
    42.5      assume "b \<le> q * a div p";
    42.6      then have "p * b \<le> p * ((q * a) div p)";
    42.7 -      by (insert p_g_2, auto simp add: zmult_zle_cancel1)
    42.8 +      by (insert p_g_2, auto simp add: mult_le_cancel_left)
    42.9      also have "... \<le> q * a";
   42.10        by (rule zdiv_leq_prop, insert p_g_2, auto)
   42.11      finally have "p * b \<le> q * a" .;
   42.12 @@ -353,7 +353,7 @@
   42.13    proof -;
   42.14      assume "a \<le> p * b div q";
   42.15      then have "q * a \<le> q * ((p * b) div q)";
   42.16 -      by (insert q_g_2, auto simp add: zmult_zle_cancel1)
   42.17 +      by (insert q_g_2, auto simp add: mult_le_cancel_left)
   42.18      also have "... \<le> p * b";
   42.19        by (rule zdiv_leq_prop, insert q_g_2, auto)
   42.20      finally have "q * a \<le> p * b" .;
   42.21 @@ -425,7 +425,7 @@
   42.22          assume "0 < x" and "x \<le> q * j div p";
   42.23          with j_fact P_set_def  have "j \<le> (p - 1) div 2"; by auto
   42.24          with q_g_2; have "q * j \<le> q * ((p - 1) div 2)";
   42.25 -          by (auto simp add: zmult_zle_cancel1)
   42.26 +          by (auto simp add: mult_le_cancel_left)
   42.27          with p_g_2 have "q * j div p \<le> q * ((p - 1) div 2) div p";
   42.28            by (auto simp add: zdiv_mono1)
   42.29          also from prems have "... \<le> (q - 1) div 2";
   42.30 @@ -437,7 +437,7 @@
   42.31    also have "... = (q * j) div p";
   42.32    proof -;
   42.33      from j_fact P_set_def have "0 \<le> j" by auto
   42.34 -    with q_g_2 have "q * 0 \<le> q * j" by (auto simp only: zmult_zle_mono2)
   42.35 +    with q_g_2 have "q * 0 \<le> q * j" by (auto simp only: mult_left_mono)
   42.36      then have "0 \<le> q * j" by auto
   42.37      then have "0 div p \<le> (q * j) div p";
   42.38        apply (rule_tac a = 0 in zdiv_mono1)
   42.39 @@ -478,7 +478,7 @@
   42.40          assume "0 < x" and "x \<le> p * j div q";
   42.41          with j_fact Q_set_def  have "j \<le> (q - 1) div 2"; by auto
   42.42          with p_g_2; have "p * j \<le> p * ((q - 1) div 2)";
   42.43 -          by (auto simp add: zmult_zle_cancel1)
   42.44 +          by (auto simp add: mult_le_cancel_left)
   42.45          with q_g_2 have "p * j div q \<le> p * ((q - 1) div 2) div q";
   42.46            by (auto simp add: zdiv_mono1)
   42.47          also from prems have "... \<le> (p - 1) div 2";
   42.48 @@ -490,7 +490,7 @@
   42.49    also have "... = (p * j) div q";
   42.50    proof -;
   42.51      from j_fact Q_set_def have "0 \<le> j" by auto
   42.52 -    with p_g_2 have "p * 0 \<le> p * j" by (auto simp only: zmult_zle_mono2)
   42.53 +    with p_g_2 have "p * 0 \<le> p * j" by (auto simp only: mult_left_mono)
   42.54      then have "0 \<le> p * j" by auto
   42.55      then have "0 div q \<le> (p * j) div q";
   42.56        apply (rule_tac a = 0 in zdiv_mono1)
    43.1 --- a/src/HOL/Numeral.thy	Sat Feb 14 02:06:12 2004 +0100
    43.2 +++ b/src/HOL/Numeral.thy	Sun Feb 15 10:46:37 2004 +0100
    43.3 @@ -8,14 +8,24 @@
    43.4  theory Numeral = Datatype
    43.5  files "Tools/numeral_syntax.ML":
    43.6  
    43.7 -(* The constructors Pls/Min are hidden in numeral_syntax.ML.
    43.8 -   Only qualified access bin.Pls/Min is allowed.
    43.9 -   Should also hide Bit, but that means one cannot use BIT anymore.
   43.10 -*)
   43.11 +text{* The file @{text numeral_syntax.ML} hides the constructors Pls and Min.
   43.12 +   Only qualified access bin.Pls and bin.Min is allowed.
   43.13 +   We do not hide Bit because we need the BIT infix syntax.*}
   43.14 +
   43.15 +text{*A number can have multiple representations, namely leading Falses with
   43.16 +sign @{term Pls} and leading Trues with sign @{term Min}.
   43.17 +See @{text "ZF/Integ/twos-compl.ML"}, function @{text int_of_binary},
   43.18 +for the numerical interpretation.
   43.19 +
   43.20 +The representation expects that @{text "(m mod 2)"} is 0 or 1,
   43.21 +even if m is negative;
   43.22 +For instance, @{text "-5 div 2 = -3"} and @{text "-5 mod 2 = 1"}; thus
   43.23 +@{text "-5 = (-3)*2 + 1"}.
   43.24 +*}
   43.25  
   43.26  datatype
   43.27 -  bin = Pls
   43.28 -      | Min
   43.29 +  bin = Pls  --{*Plus: Stands for an infinite string of leading Falses*}
   43.30 +      | Min --{*Minus: Stands for an infinite string of leading Trues*}
   43.31        | Bit bin bool    (infixl "BIT" 90)
   43.32  
   43.33  axclass
   43.34 @@ -58,4 +68,136 @@
   43.35    by (simp add: Let_def)
   43.36  
   43.37  
   43.38 +consts
   43.39 +  ring_of :: "bin => 'a::ring"
   43.40 +
   43.41 +  NCons     :: "[bin,bool]=>bin"
   43.42 +  bin_succ  :: "bin=>bin"
   43.43 +  bin_pred  :: "bin=>bin"
   43.44 +  bin_minus :: "bin=>bin"
   43.45 +  bin_add   :: "[bin,bin]=>bin"
   43.46 +  bin_mult  :: "[bin,bin]=>bin"
   43.47 +
   43.48 +text{*@{term NCons} inserts a bit, suppressing leading 0s and 1s*}
   43.49 +primrec
   43.50 +  NCons_Pls:  "NCons bin.Pls b = (if b then (bin.Pls BIT b) else bin.Pls)"
   43.51 +  NCons_Min:  "NCons bin.Min b = (if b then bin.Min else (bin.Min BIT b))"
   43.52 +  NCons_BIT:  "NCons (w BIT x) b = (w BIT x) BIT b"
   43.53 +
   43.54 +
   43.55 +primrec 
   43.56 +  ring_of_Pls: "ring_of bin.Pls = 0"
   43.57 +  ring_of_Min: "ring_of bin.Min = - (1::'a::ring)"
   43.58 +  ring_of_BIT: "ring_of(w BIT x) = (if x then 1 else 0) +
   43.59 +	                               (ring_of w) + (ring_of w)"
   43.60 +
   43.61 +primrec
   43.62 +  bin_succ_Pls: "bin_succ bin.Pls = bin.Pls BIT True"
   43.63 +  bin_succ_Min: "bin_succ bin.Min = bin.Pls"
   43.64 +  bin_succ_BIT: "bin_succ(w BIT x) =
   43.65 +  	            (if x then bin_succ w BIT False
   43.66 +	                  else NCons w True)"
   43.67 +
   43.68 +primrec
   43.69 +  bin_pred_Pls: "bin_pred bin.Pls = bin.Min"
   43.70 +  bin_pred_Min: "bin_pred bin.Min = bin.Min BIT False"
   43.71 +  bin_pred_BIT: "bin_pred(w BIT x) =
   43.72 +	            (if x then NCons w False
   43.73 +		          else (bin_pred w) BIT True)"
   43.74 +
   43.75 +primrec
   43.76 +  bin_minus_Pls: "bin_minus bin.Pls = bin.Pls"
   43.77 +  bin_minus_Min: "bin_minus bin.Min = bin.Pls BIT True"
   43.78 +  bin_minus_BIT: "bin_minus(w BIT x) =
   43.79 +	             (if x then bin_pred (NCons (bin_minus w) False)
   43.80 +		           else bin_minus w BIT False)"
   43.81 +
   43.82 +primrec
   43.83 +  bin_add_Pls: "bin_add bin.Pls w = w"
   43.84 +  bin_add_Min: "bin_add bin.Min w = bin_pred w"
   43.85 +  bin_add_BIT:
   43.86 +    "bin_add (v BIT x) w =
   43.87 +       (case w of Pls => v BIT x
   43.88 +                | Min => bin_pred (v BIT x)
   43.89 +                | (w BIT y) =>
   43.90 +      	            NCons (bin_add v (if (x & y) then bin_succ w else w))
   43.91 +	                  (x~=y))"
   43.92 +
   43.93 +primrec
   43.94 +  bin_mult_Pls: "bin_mult bin.Pls w = bin.Pls"
   43.95 +  bin_mult_Min: "bin_mult bin.Min w = bin_minus w"
   43.96 +  bin_mult_BIT: "bin_mult (v BIT x) w =
   43.97 +	            (if x then (bin_add (NCons (bin_mult v w) False) w)
   43.98 +	                  else (NCons (bin_mult v w) False))"
   43.99 +
  43.100 +
  43.101 +subsection{*Extra rules for @{term bin_succ}, @{term bin_pred}, 
  43.102 +  @{term bin_add} and @{term bin_mult}*}
  43.103 +
  43.104 +lemma NCons_Pls_0: "NCons bin.Pls False = bin.Pls"
  43.105 +by simp
  43.106 +
  43.107 +lemma NCons_Pls_1: "NCons bin.Pls True = bin.Pls BIT True"
  43.108 +by simp
  43.109 +
  43.110 +lemma NCons_Min_0: "NCons bin.Min False = bin.Min BIT False"
  43.111 +by simp
  43.112 +
  43.113 +lemma NCons_Min_1: "NCons bin.Min True = bin.Min"
  43.114 +by simp
  43.115 +
  43.116 +lemma bin_succ_1: "bin_succ(w BIT True) = (bin_succ w) BIT False"
  43.117 +by simp
  43.118 +
  43.119 +lemma bin_succ_0: "bin_succ(w BIT False) =  NCons w True"
  43.120 +by simp
  43.121 +
  43.122 +lemma bin_pred_1: "bin_pred(w BIT True) = NCons w False"
  43.123 +by simp
  43.124 +
  43.125 +lemma bin_pred_0: "bin_pred(w BIT False) = (bin_pred w) BIT True"
  43.126 +by simp
  43.127 +
  43.128 +lemma bin_minus_1: "bin_minus(w BIT True) = bin_pred (NCons (bin_minus w) False)"
  43.129 +by simp
  43.130 +
  43.131 +lemma bin_minus_0: "bin_minus(w BIT False) = (bin_minus w) BIT False"
  43.132 +by simp
  43.133 +
  43.134 +
  43.135 +subsection{*Binary Addition and Multiplication:
  43.136 +         @{term bin_add} and @{term bin_mult}*}
  43.137 +
  43.138 +lemma bin_add_BIT_11:
  43.139 +     "bin_add (v BIT True) (w BIT True) =
  43.140 +     NCons (bin_add v (bin_succ w)) False"
  43.141 +by simp
  43.142 +
  43.143 +lemma bin_add_BIT_10:
  43.144 +     "bin_add (v BIT True) (w BIT False) = NCons (bin_add v w) True"
  43.145 +by simp
  43.146 +
  43.147 +lemma bin_add_BIT_0:
  43.148 +     "bin_add (v BIT False) (w BIT y) = NCons (bin_add v w) y"
  43.149 +by auto
  43.150 +
  43.151 +lemma bin_add_Pls_right: "bin_add w bin.Pls = w"
  43.152 +by (induct_tac "w", auto)
  43.153 +
  43.154 +lemma bin_add_Min_right: "bin_add w bin.Min = bin_pred w"
  43.155 +by (induct_tac "w", auto)
  43.156 +
  43.157 +lemma bin_add_BIT_BIT:
  43.158 +     "bin_add (v BIT x) (w BIT y) =
  43.159 +     NCons(bin_add v (if x & y then (bin_succ w) else w)) (x~= y)"
  43.160 +by simp
  43.161 +
  43.162 +lemma bin_mult_1:
  43.163 +     "bin_mult (v BIT True) w = bin_add (NCons (bin_mult v w) False) w"
  43.164 +by simp
  43.165 +
  43.166 +lemma bin_mult_0: "bin_mult (v BIT False) w = NCons (bin_mult v w) False"
  43.167 +by simp
  43.168 +
  43.169 +
  43.170  end
    44.1 --- a/src/HOL/ROOT.ML	Sat Feb 14 02:06:12 2004 +0100
    44.2 +++ b/src/HOL/ROOT.ML	Sun Feb 15 10:46:37 2004 +0100
    44.3 @@ -29,7 +29,6 @@
    44.4  use "~~/src/Provers/Arith/abel_cancel.ML";
    44.5  use "~~/src/Provers/Arith/assoc_fold.ML";
    44.6  use "~~/src/Provers/quantifier1.ML";
    44.7 -use "~~/src/Provers/Arith/abstract_numerals.ML";
    44.8  use "~~/src/Provers/Arith/cancel_numerals.ML";
    44.9  use "~~/src/Provers/Arith/combine_numerals.ML";
   44.10  use "~~/src/Provers/Arith/cancel_numeral_factor.ML";
    45.1 --- a/src/HOL/Real/PReal.thy	Sat Feb 14 02:06:12 2004 +0100
    45.2 +++ b/src/HOL/Real/PReal.thy	Sun Feb 15 10:46:37 2004 +0100
    45.3 @@ -7,7 +7,7 @@
    45.4                    provides some of the definitions.
    45.5  *)
    45.6  
    45.7 -theory PReal = RatArith:
    45.8 +theory PReal = Rational:
    45.9  
   45.10  text{*Could be generalized and moved to @{text Ring_and_Field}*}
   45.11  lemma add_eq_exists: "\<exists>x. a+x = (b::rat)"
    46.1 --- a/src/HOL/Real/RComplete.thy	Sat Feb 14 02:06:12 2004 +0100
    46.2 +++ b/src/HOL/Real/RComplete.thy	Sun Feb 15 10:46:37 2004 +0100
    46.3 @@ -8,11 +8,10 @@
    46.4  
    46.5  header{*Completeness Theorems for Positive Reals and Reals.*}
    46.6  
    46.7 -theory RComplete = Lubs + RealArith:
    46.8 +theory RComplete = Lubs + RealDef:
    46.9  
   46.10  lemma real_sum_of_halves: "x/2 + x/2 = (x::real)"
   46.11 -apply (simp)
   46.12 -done
   46.13 +by simp
   46.14  
   46.15  
   46.16  subsection{*Completeness of Reals by Supremum Property of type @{typ preal}*} 
   46.17 @@ -32,8 +31,7 @@
   46.18  apply (drule bspec, assumption)
   46.19  apply (frule bspec, assumption)
   46.20  apply (drule order_less_trans, assumption)
   46.21 -apply (drule real_gt_zero_preal_Ex [THEN iffD1])
   46.22 -apply (force) 
   46.23 +apply (drule real_gt_zero_preal_Ex [THEN iffD1], force) 
   46.24  done
   46.25  
   46.26  (*-------------------------------------------------------------
   46.27 @@ -55,12 +53,10 @@
   46.28  apply (case_tac "0 < ya", auto)
   46.29  apply (frule real_sup_lemma2, assumption+)
   46.30  apply (drule real_gt_zero_preal_Ex [THEN iffD1])
   46.31 -apply (drule_tac [3] real_less_all_real2)
   46.32 -apply (auto)
   46.33 +apply (drule_tac [3] real_less_all_real2, auto)
   46.34  apply (rule preal_complete [THEN iffD1])
   46.35  apply (auto intro: order_less_imp_le)
   46.36 -apply (frule real_gt_preal_preal_Ex)
   46.37 -apply (force)
   46.38 +apply (frule real_gt_preal_preal_Ex, force)
   46.39  (* second part *)
   46.40  apply (rule real_sup_lemma1 [THEN iffD2], assumption)
   46.41  apply (auto dest!: real_less_all_real2 real_gt_zero_preal_Ex [THEN iffD1])
   46.42 @@ -131,8 +127,7 @@
   46.43  apply (subgoal_tac "\<exists>u. u\<in> {z. \<exists>x \<in>S. z = x + (-X) + 1} Int {x. 0 < x}")
   46.44  apply (subgoal_tac "isUb (UNIV::real set) ({z. \<exists>x \<in>S. z = x + (-X) + 1} Int {x. 0 < x}) (Y + (-X) + 1) ")
   46.45  apply (cut_tac P = S and xa = X in real_sup_lemma3)
   46.46 -apply (frule posreals_complete [OF _ _ exI], blast, blast) 
   46.47 -apply safe
   46.48 +apply (frule posreals_complete [OF _ _ exI], blast, blast, safe)
   46.49  apply (rule_tac x = "t + X + (- 1) " in exI)
   46.50  apply (rule isLubI2)
   46.51  apply (rule_tac [2] setgeI, safe)
    47.1 --- a/src/HOL/Real/RatArith.thy	Sat Feb 14 02:06:12 2004 +0100
    47.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    47.3 @@ -1,161 +0,0 @@
    47.4 -(*  Title:      HOL/RatArith.thy
    47.5 -    ID:         $Id$
    47.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    47.7 -    Copyright   2004  University of Cambridge
    47.8 -
    47.9 -Binary arithmetic and simplification for the rats
   47.10 -
   47.11 -This case is reduced to that for the integers
   47.12 -*)
   47.13 -
   47.14 -theory RatArith = Rational
   47.15 -files ("rat_arith.ML"):
   47.16 -
   47.17 -instance rat :: number ..
   47.18 -
   47.19 -defs (overloaded)
   47.20 -  rat_number_of_def:
   47.21 -    "(number_of v :: rat) == of_int (number_of v)"
   47.22 -     (*::bin=>rat         ::bin=>int*)
   47.23 -
   47.24 -
   47.25 -lemma rat_numeral_0_eq_0: "Numeral0 = (0::rat)"
   47.26 -by (simp add: rat_number_of_def zero_rat [symmetric])
   47.27 -
   47.28 -lemma rat_numeral_1_eq_1: "Numeral1 = (1::rat)"
   47.29 -by (simp add: rat_number_of_def one_rat [symmetric])
   47.30 -
   47.31 -
   47.32 -subsection{*Arithmetic Operations On Numerals*}
   47.33 -
   47.34 -lemma add_rat_number_of [simp]:
   47.35 -     "(number_of v :: rat) + number_of v' = number_of (bin_add v v')" 
   47.36 -by (simp only: rat_number_of_def of_int_add number_of_add)
   47.37 -
   47.38 -lemma minus_rat_number_of [simp]:
   47.39 -     "- (number_of w :: rat) = number_of (bin_minus w)"
   47.40 -by (simp only: rat_number_of_def of_int_minus number_of_minus)
   47.41 -
   47.42 -lemma diff_rat_number_of [simp]: 
   47.43 -   "(number_of v :: rat) - number_of w = number_of (bin_add v (bin_minus w))"
   47.44 -by (simp only: add_rat_number_of minus_rat_number_of diff_minus)
   47.45 -
   47.46 -lemma mult_rat_number_of [simp]:
   47.47 -     "(number_of v :: rat) * number_of v' = number_of (bin_mult v v')"
   47.48 -by (simp only: rat_number_of_def of_int_mult number_of_mult)
   47.49 -
   47.50 -text{*Lemmas for specialist use, NOT as default simprules*}
   47.51 -lemma rat_mult_2: "2 * z = (z+z::rat)"
   47.52 -proof -
   47.53 -  have eq: "(2::rat) = 1 + 1"
   47.54 -    by (simp del: rat_number_of_def add: rat_numeral_1_eq_1 [symmetric])
   47.55 -  thus ?thesis by (simp add: eq left_distrib)
   47.56 -qed
   47.57 -
   47.58 -lemma rat_mult_2_right: "z * 2 = (z+z::rat)"
   47.59 -by (subst mult_commute, rule rat_mult_2)
   47.60 -
   47.61 -
   47.62 -subsection{*Comparisons On Numerals*}
   47.63 -
   47.64 -lemma eq_rat_number_of [simp]:
   47.65 -     "((number_of v :: rat) = number_of v') =  
   47.66 -      iszero (number_of (bin_add v (bin_minus v')) :: int)"
   47.67 -by (simp add: rat_number_of_def)
   47.68 -
   47.69 -text{*@{term neg} is used in rewrite rules for binary comparisons*}
   47.70 -lemma less_rat_number_of [simp]:
   47.71 -     "((number_of v :: rat) < number_of v') =  
   47.72 -      neg (number_of (bin_add v (bin_minus v')) :: int)"
   47.73 -by (simp add: rat_number_of_def)
   47.74 -
   47.75 -
   47.76 -text{*New versions of existing theorems involving 0, 1*}
   47.77 -
   47.78 -lemma rat_minus_1_eq_m1 [simp]: "- 1 = (-1::rat)"
   47.79 -by (simp del: rat_number_of_def add: rat_numeral_1_eq_1 [symmetric])
   47.80 -
   47.81 -lemma rat_mult_minus1 [simp]: "-1 * z = -(z::rat)"
   47.82 -proof -
   47.83 -  have  "-1 * z = (- 1) * z" by (simp add: rat_minus_1_eq_m1)
   47.84 -  also have "... = - (1 * z)" by (simp only: minus_mult_left) 
   47.85 -  also have "... = -z" by simp
   47.86 -  finally show ?thesis .
   47.87 -qed
   47.88 -
   47.89 -lemma rat_mult_minus1_right [simp]: "z * -1 = -(z::rat)"
   47.90 -by (subst mult_commute, rule rat_mult_minus1)
   47.91 -
   47.92 -
   47.93 -subsection{*Simplification of Arithmetic when Nested to the Right*}
   47.94 -
   47.95 -lemma rat_add_number_of_left [simp]:
   47.96 -     "number_of v + (number_of w + z) = (number_of(bin_add v w) + z::rat)"
   47.97 -by (simp add: add_assoc [symmetric])
   47.98 -
   47.99 -lemma rat_mult_number_of_left [simp]:
  47.100 -     "number_of v * (number_of w * z) = (number_of(bin_mult v w) * z::rat)"
  47.101 -apply (simp add: mult_assoc [symmetric])
  47.102 -done
  47.103 -
  47.104 -lemma rat_add_number_of_diff1 [simp]: 
  47.105 -     "number_of v + (number_of w - c) = number_of(bin_add v w) - (c::rat)"
  47.106 -apply (unfold diff_rat_def)
  47.107 -apply (rule rat_add_number_of_left)
  47.108 -done
  47.109 -
  47.110 -lemma rat_add_number_of_diff2 [simp]:
  47.111 -     "number_of v + (c - number_of w) =  
  47.112 -      number_of (bin_add v (bin_minus w)) + (c::rat)"
  47.113 -apply (subst diff_rat_number_of [symmetric])
  47.114 -apply (simp only: diff_rat_def add_ac)
  47.115 -done
  47.116 -
  47.117 -
  47.118 -declare rat_numeral_0_eq_0 [simp] rat_numeral_1_eq_1 [simp]
  47.119 -
  47.120 -lemmas rat_add_0_left = add_0 [where ?'a = rat]
  47.121 -lemmas rat_add_0_right = add_0_right [where ?'a = rat]
  47.122 -lemmas rat_mult_1_left = mult_1 [where ?'a = rat]
  47.123 -lemmas rat_mult_1_right = mult_1_right [where ?'a = rat]
  47.124 -
  47.125 -
  47.126 -declare diff_rat_def [symmetric]
  47.127 -
  47.128 -
  47.129 -use "rat_arith.ML"
  47.130 -
  47.131 -setup rat_arith_setup
  47.132 -
  47.133 -
  47.134 -subsubsection{*Division By @{term "-1"}*}
  47.135 -
  47.136 -lemma rat_divide_minus1 [simp]: "x/-1 = -(x::rat)" 
  47.137 -by simp
  47.138 -
  47.139 -lemma rat_minus1_divide [simp]: "-1/(x::rat) = - (1/x)"
  47.140 -by (simp add: divide_rat_def inverse_minus_eq)
  47.141 -
  47.142 -subsection{*Absolute Value Function for the Rats*}
  47.143 -
  47.144 -lemma abs_nat_number_of [simp]: 
  47.145 -     "abs (number_of v :: rat) =  
  47.146 -        (if neg (number_of v :: int)  then number_of (bin_minus v)  
  47.147 -         else number_of v)"
  47.148 -by (simp add: abs_if) 
  47.149 -
  47.150 -lemma abs_minus_one [simp]: "abs (-1) = (1::rat)"
  47.151 -by (simp add: abs_if)
  47.152 -
  47.153 -declare rat_number_of_def [simp]
  47.154 -
  47.155 -
  47.156 -ML
  47.157 -{*
  47.158 -val rat_divide_minus1 = thm "rat_divide_minus1";
  47.159 -val rat_minus1_divide = thm "rat_minus1_divide";
  47.160 -val abs_nat_number_of = thm "abs_nat_number_of";
  47.161 -val abs_minus_one = thm "abs_minus_one";
  47.162 -*}
  47.163 -
  47.164 -end
    48.1 --- a/src/HOL/Real/Rational.thy	Sat Feb 14 02:06:12 2004 +0100
    48.2 +++ b/src/HOL/Real/Rational.thy	Sun Feb 15 10:46:37 2004 +0100
    48.3 @@ -9,7 +9,8 @@
    48.4    \author{Markus Wenzel}
    48.5  *}
    48.6  
    48.7 -theory Rational = Quotient + Ring_and_Field:
    48.8 +theory Rational = Quotient + Main
    48.9 +files ("rat_arith.ML"):
   48.10  
   48.11  subsection {* Fractions *}
   48.12  
   48.13 @@ -693,4 +694,35 @@
   48.14  qed 
   48.15  
   48.16  
   48.17 +
   48.18 +subsection{*Numerals and Arithmetic*}
   48.19 +
   48.20 +instance rat :: number ..
   48.21 +
   48.22 +primrec (*the type constraint is essential!*)
   48.23 +  number_of_Pls: "number_of bin.Pls = 0"
   48.24 +  number_of_Min: "number_of bin.Min = - (1::rat)"
   48.25 +  number_of_BIT: "number_of(w BIT x) = (if x then 1 else 0) +
   48.26 +	                               (number_of w) + (number_of w)"
   48.27 +
   48.28 +declare number_of_Pls [simp del]
   48.29 +        number_of_Min [simp del]
   48.30 +        number_of_BIT [simp del]
   48.31 +
   48.32 +instance rat :: number_ring
   48.33 +proof
   48.34 +  show "Numeral0 = (0::rat)" by (rule number_of_Pls)
   48.35 +  show "-1 = - (1::rat)" by (rule number_of_Min)
   48.36 +  fix w :: bin and x :: bool
   48.37 +  show "(number_of (w BIT x) :: rat) =
   48.38 +        (if x then 1 else 0) + number_of w + number_of w"
   48.39 +    by (rule number_of_BIT)
   48.40 +qed
   48.41 +
   48.42 +declare diff_rat_def [symmetric]
   48.43 +
   48.44 +use "rat_arith.ML"
   48.45 +
   48.46 +setup rat_arith_setup
   48.47 +
   48.48  end
    49.1 --- a/src/HOL/Real/RealArith.thy	Sat Feb 14 02:06:12 2004 +0100
    49.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    49.3 @@ -1,317 +0,0 @@
    49.4 -(*  Title:      HOL/RealArith.thy
    49.5 -    ID:         $Id$
    49.6 -    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    49.7 -    Copyright   1999  University of Cambridge
    49.8 -*)
    49.9 -
   49.10 -header{*Binary arithmetic and Simplification for the Reals*}
   49.11 -
   49.12 -theory RealArith = RealDef
   49.13 -files ("real_arith.ML"):
   49.14 -
   49.15 -instance real :: number ..
   49.16 -
   49.17 -defs
   49.18 -  real_number_of_def:
   49.19 -    "number_of v == real (number_of v :: int)"
   49.20 -     (*::bin=>real           ::bin=>int*)
   49.21 -
   49.22 -text{*Collapse applications of @{term real} to @{term number_of}*}
   49.23 -declare real_number_of_def [symmetric, simp]
   49.24 -
   49.25 -lemma real_numeral_0_eq_0: "Numeral0 = (0::real)"
   49.26 -by (simp add: real_number_of_def)
   49.27 -
   49.28 -lemma real_numeral_1_eq_1: "Numeral1 = (1::real)"
   49.29 -apply (unfold real_number_of_def)
   49.30 -apply (subst real_of_one [symmetric], simp)
   49.31 -done
   49.32 -
   49.33 -
   49.34 -subsection{*Arithmetic Operations On Numerals*}
   49.35 -
   49.36 -lemma add_real_number_of [simp]:
   49.37 -     "(number_of v :: real) + number_of v' = number_of (bin_add v v')"
   49.38 -by (simp only: real_number_of_def real_of_int_add number_of_add)
   49.39 -
   49.40 -lemma minus_real_number_of [simp]:
   49.41 -     "- (number_of w :: real) = number_of (bin_minus w)"
   49.42 -by (simp only: real_number_of_def number_of_minus real_of_int_minus)
   49.43 -
   49.44 -lemma diff_real_number_of [simp]: 
   49.45 -   "(number_of v :: real) - number_of w = number_of (bin_add v (bin_minus w))"
   49.46 -by (simp only: real_number_of_def diff_number_of_eq real_of_int_diff)
   49.47 -
   49.48 -lemma mult_real_number_of [simp]:
   49.49 -     "(number_of v :: real) * number_of v' = number_of (bin_mult v v')"
   49.50 -by (simp only: real_number_of_def real_of_int_mult number_of_mult)
   49.51 -
   49.52 -
   49.53 -text{*Lemmas for specialist use, NOT as default simprules*}
   49.54 -lemma real_mult_2: "2 * z = (z+z::real)"
   49.55 -proof -
   49.56 -  have eq: "(2::real) = 1 + 1" by (simp add: real_numeral_1_eq_1 [symmetric])
   49.57 -  thus ?thesis by (simp add: eq left_distrib)
   49.58 -qed
   49.59 -
   49.60 -lemma real_mult_2_right: "z * 2 = (z+z::real)"
   49.61 -by (subst mult_commute, rule real_mult_2)
   49.62 -
   49.63 -
   49.64 -subsection{*Comparisons On Numerals*}
   49.65 -
   49.66 -lemma eq_real_number_of [simp]:
   49.67 -     "((number_of v :: real) = number_of v') =  
   49.68 -      iszero (number_of (bin_add v (bin_minus v')) :: int)"
   49.69 -by (simp only: real_number_of_def real_of_int_inject eq_number_of_eq)
   49.70 -
   49.71 -text{*@{term neg} is used in rewrite rules for binary comparisons*}
   49.72 -lemma less_real_number_of [simp]:
   49.73 -     "((number_of v :: real) < number_of v') =  
   49.74 -      neg (number_of (bin_add v (bin_minus v')) :: int)"
   49.75 -by (simp only: real_number_of_def real_of_int_less_iff less_number_of_eq_neg)
   49.76 -
   49.77 -
   49.78 -text{*New versions of existing theorems involving 0, 1*}
   49.79 -
   49.80 -lemma real_minus_1_eq_m1 [simp]: "- 1 = (-1::real)"
   49.81 -by (simp add: real_numeral_1_eq_1 [symmetric])
   49.82 -
   49.83 -lemma real_mult_minus1 [simp]: "-1 * z = -(z::real)"
   49.84 -proof -
   49.85 -  have  "-1 * z = (- 1) * z" by (simp add: real_minus_1_eq_m1)
   49.86 -  also have "... = - (1 * z)" by (simp only: minus_mult_left) 
   49.87 -  also have "... = -z" by simp
   49.88 -  finally show ?thesis .
   49.89 -qed
   49.90 -
   49.91 -lemma real_mult_minus1_right [simp]: "z * -1 = -(z::real)"
   49.92 -by (subst mult_commute, rule real_mult_minus1)
   49.93 -
   49.94 -
   49.95 -
   49.96 -(** real from type "nat" **)
   49.97 -
   49.98 -lemma zero_less_real_of_nat_iff [iff]: "(0 < real (n::nat)) = (0<n)"
   49.99 -by (simp only: real_of_nat_less_iff real_of_nat_zero [symmetric])
  49.100 -
  49.101 -lemma zero_le_real_of_nat_iff [iff]: "(0 <= real (n::nat)) = (0<=n)"
  49.102 -by (simp only: real_of_nat_le_iff real_of_nat_zero [symmetric])
  49.103 -
  49.104 -
  49.105 -(*Like the ones above, for "equals"*)
  49.106 -declare real_of_nat_zero_iff [iff]
  49.107 -
  49.108 -
  49.109 -subsection{*Simplification of Arithmetic when Nested to the Right*}
  49.110 -
  49.111 -lemma real_add_number_of_left [simp]:
  49.112 -     "number_of v + (number_of w + z) = (number_of(bin_add v w) + z::real)"
  49.113 -by (simp add: add_assoc [symmetric])
  49.114 -
  49.115 -lemma real_mult_number_of_left [simp]:
  49.116 -     "number_of v * (number_of w * z) = (number_of(bin_mult v w) * z::real)"
  49.117 -apply (simp (no_asm) add: mult_assoc [symmetric])
  49.118 -done
  49.119 -
  49.120 -lemma real_add_number_of_diff1 [simp]: 
  49.121 -     "number_of v + (number_of w - c) = number_of(bin_add v w) - (c::real)"
  49.122 -apply (unfold real_diff_def)
  49.123 -apply (rule real_add_number_of_left)
  49.124 -done
  49.125 -
  49.126 -lemma real_add_number_of_diff2 [simp]:
  49.127 -     "number_of v + (c - number_of w) =  
  49.128 -      number_of (bin_add v (bin_minus w)) + (c::real)"
  49.129 -apply (subst diff_real_number_of [symmetric])
  49.130 -apply (simp only: real_diff_def add_ac)
  49.131 -done
  49.132 -
  49.133 -
  49.134 -text{*The constant @{term neg} is used in rewrite rules for binary
  49.135 -comparisons. A complication in this proof is that both @{term real} and @{term
  49.136 -number_of} are polymorphic, so that it's difficult to know what types subterms
  49.137 -have. *}
  49.138 -lemma real_of_nat_number_of [simp]:
  49.139 -     "real (number_of v :: nat) =  
  49.140 -        (if neg (number_of v :: int) then 0  
  49.141 -         else (number_of v :: real))"
  49.142 -proof cases
  49.143 -  assume "neg (number_of v :: int)" thus ?thesis by simp
  49.144 -next
  49.145 -  assume neg: "~ neg (number_of v :: int)"
  49.146 -  thus ?thesis
  49.147 -    by (simp only: nat_number_of_def real_of_nat_real_of_int [OF neg], simp) 
  49.148 -qed
  49.149 -
  49.150 -declare real_numeral_0_eq_0 [simp] real_numeral_1_eq_1 [simp]
  49.151 -
  49.152 -
  49.153 -use "real_arith.ML"
  49.154 -
  49.155 -setup real_arith_setup
  49.156 -
  49.157 -subsection{* Simprules combining x+y and 0: ARE THEY NEEDED?*}
  49.158 -
  49.159 -text{*Needed in this non-standard form by Hyperreal/Transcendental*}
  49.160 -lemma real_0_le_divide_iff:
  49.161 -     "((0::real) \<le> x/y) = ((x \<le> 0 | 0 \<le> y) & (0 \<le> x | y \<le> 0))"
  49.162 -by (simp add: real_divide_def zero_le_mult_iff, auto)
  49.163 -
  49.164 -lemma real_add_minus_iff [simp]: "(x + - a = (0::real)) = (x=a)" 
  49.165 -by arith
  49.166 -
  49.167 -lemma real_add_eq_0_iff [iff]: "(x+y = (0::real)) = (y = -x)"
  49.168 -by auto
  49.169 -
  49.170 -lemma real_add_less_0_iff [iff]: "(x+y < (0::real)) = (y < -x)"
  49.171 -by auto
  49.172 -
  49.173 -lemma real_0_less_add_iff [iff]: "((0::real) < x+y) = (-x < y)"
  49.174 -by auto
  49.175 -
  49.176 -lemma real_add_le_0_iff [iff]: "(x+y \<le> (0::real)) = (y \<le> -x)"
  49.177 -by auto
  49.178 -
  49.179 -lemma real_0_le_add_iff [iff]: "((0::real) \<le> x+y) = (-x \<le> y)"
  49.180 -by auto
  49.181 -
  49.182 -
  49.183 -(** Simprules combining x-y and 0 (needed??) **)
  49.184 -
  49.185 -lemma real_0_less_diff_iff [iff]: "((0::real) < x-y) = (y < x)"
  49.186 -by auto
  49.187 -
  49.188 -lemma real_0_le_diff_iff [iff]: "((0::real) \<le> x-y) = (y \<le> x)"
  49.189 -by auto
  49.190 -
  49.191 -(*
  49.192 -FIXME: we should have this, as for type int, but many proofs would break.
  49.193 -It replaces x+-y by x-y.
  49.194 -Addsimps [symmetric real_diff_def]
  49.195 -*)
  49.196 -
  49.197 -subsubsection{*Division By @{term "-1"}*}
  49.198 -
  49.199 -lemma real_divide_minus1 [simp]: "x/-1 = -(x::real)"
  49.200 -by simp
  49.201 -
  49.202 -lemma real_minus1_divide [simp]: "-1/(x::real) = - (1/x)"
  49.203 -by (simp add: real_divide_def inverse_minus_eq)
  49.204 -
  49.205 -lemma real_lbound_gt_zero:
  49.206 -     "[| (0::real) < d1; 0 < d2 |] ==> \<exists>e. 0 < e & e < d1 & e < d2"
  49.207 -apply (rule_tac x = " (min d1 d2) /2" in exI)
  49.208 -apply (simp add: min_def)
  49.209 -done
  49.210 -
  49.211 -(*** Density of the Reals ***)
  49.212 -
  49.213 -text{*Similar results are proved in @{text Ring_and_Field}*}
  49.214 -lemma real_less_half_sum: "x < y ==> x < (x+y) / (2::real)"
  49.215 -  by auto
  49.216 -
  49.217 -lemma real_gt_half_sum: "x < y ==> (x+y)/(2::real) < y"
  49.218 -  by auto
  49.219 -
  49.220 -lemma real_dense: "x < y ==> \<exists>r::real. x < r & r < y"
  49.221 -  by (rule Ring_and_Field.dense)
  49.222 -
  49.223 -
  49.224 -subsection{*Absolute Value Function for the Reals*}
  49.225 -
  49.226 -lemma abs_nat_number_of [simp]: 
  49.227 -     "abs (number_of v :: real) =  
  49.228 -        (if neg (number_of v :: int) then number_of (bin_minus v)  
  49.229 -         else number_of v)"
  49.230 -by (simp add: real_abs_def bin_arith_simps minus_real_number_of
  49.231 -       less_real_number_of real_of_int_le_iff)
  49.232 -
  49.233 -text{*FIXME: these should go!*}
  49.234 -lemma abs_eqI1: "(0::real)\<le>x ==> abs x = x"
  49.235 -by (unfold real_abs_def, simp)
  49.236 -
  49.237 -lemma abs_eqI2: "(0::real) < x ==> abs x = x"
  49.238 -by (unfold real_abs_def, simp)
  49.239 -
  49.240 -lemma abs_minus_eqI2: "x < (0::real) ==> abs x = -x"
  49.241 -by (simp add: real_abs_def linorder_not_less [symmetric])
  49.242 -
  49.243 -lemma abs_minus_add_cancel: "abs(x + (-y)) = abs (y + (-(x::real)))"
  49.244 -by (unfold real_abs_def, simp)
  49.245 -
  49.246 -lemma abs_minus_one [simp]: "abs (-1) = (1::real)"
  49.247 -by (unfold real_abs_def, simp)
  49.248 -
  49.249 -lemma abs_interval_iff: "(abs x < r) = (-r < x & x < (r::real))"
  49.250 -by (force simp add: Ring_and_Field.abs_less_iff)
  49.251 -
  49.252 -lemma abs_le_interval_iff: "(abs x \<le> r) = (-r\<le>x & x\<le>(r::real))"
  49.253 -by (force simp add: Ring_and_Field.abs_le_iff)
  49.254 -
  49.255 -lemma abs_add_one_gt_zero [simp]: "(0::real) < 1 + abs(x)"
  49.256 -by (unfold real_abs_def, auto)
  49.257 -
  49.258 -lemma abs_real_of_nat_cancel [simp]: "abs (real x) = real (x::nat)"
  49.259 -by (auto intro: abs_eqI1 simp add: real_of_nat_ge_zero)
  49.260 -
  49.261 -lemma abs_add_one_not_less_self [simp]: "~ abs(x) + (1::real) < x"
  49.262 -apply (simp add: linorder_not_less)
  49.263 -apply (auto intro: abs_ge_self [THEN order_trans])
  49.264 -done
  49.265 - 
  49.266 -text{*Used only in Hyperreal/Lim.ML*}
  49.267 -lemma abs_sum_triangle_ineq: "abs ((x::real) + y + (-l + -m)) \<le> abs(x + -l) + abs(y + -m)"
  49.268 -apply (simp add: real_add_assoc)
  49.269 -apply (rule_tac a1 = y in add_left_commute [THEN ssubst])
  49.270 -apply (rule real_add_assoc [THEN subst])
  49.271 -apply (rule abs_triangle_ineq)
  49.272 -done
  49.273 -
  49.274 -
  49.275 -
  49.276 -ML
  49.277 -{*
  49.278 -val real_0_le_divide_iff = thm"real_0_le_divide_iff";
  49.279 -val real_add_minus_iff = thm"real_add_minus_iff";
  49.280 -val real_add_eq_0_iff = thm"real_add_eq_0_iff";
  49.281 -val real_add_less_0_iff = thm"real_add_less_0_iff";
  49.282 -val real_0_less_add_iff = thm"real_0_less_add_iff";
  49.283 -val real_add_le_0_iff = thm"real_add_le_0_iff";
  49.284 -val real_0_le_add_iff = thm"real_0_le_add_iff";
  49.285 -val real_0_less_diff_iff = thm"real_0_less_diff_iff";
  49.286 -val real_0_le_diff_iff = thm"real_0_le_diff_iff";
  49.287 -val real_divide_minus1 = thm"real_divide_minus1";
  49.288 -val real_minus1_divide = thm"real_minus1_divide";
  49.289 -val real_lbound_gt_zero = thm"real_lbound_gt_zero";
  49.290 -val real_less_half_sum = thm"real_less_half_sum";
  49.291 -val real_gt_half_sum = thm"real_gt_half_sum";
  49.292 -val real_dense = thm"real_dense";
  49.293 -
  49.294 -val abs_nat_number_of = thm"abs_nat_number_of";
  49.295 -val abs_eqI1 = thm"abs_eqI1";
  49.296 -val abs_eqI2 = thm"abs_eqI2";
  49.297 -val abs_minus_eqI2 = thm"abs_minus_eqI2";
  49.298 -val abs_ge_zero = thm"abs_ge_zero";
  49.299 -val abs_idempotent = thm"abs_idempotent";
  49.300 -val abs_zero_iff = thm"abs_zero_iff";
  49.301 -val abs_ge_self = thm"abs_ge_self";
  49.302 -val abs_ge_minus_self = thm"abs_ge_minus_self";
  49.303 -val abs_mult = thm"abs_mult";
  49.304 -val abs_inverse = thm"abs_inverse";
  49.305 -val abs_triangle_ineq = thm"abs_triangle_ineq";
  49.306 -val abs_minus_cancel = thm"abs_minus_cancel";
  49.307 -val abs_minus_add_cancel = thm"abs_minus_add_cancel";
  49.308 -val abs_minus_one = thm"abs_minus_one";
  49.309 -val abs_interval_iff = thm"abs_interval_iff";
  49.310 -val abs_le_interval_iff = thm"abs_le_interval_iff";
  49.311 -val abs_add_one_gt_zero = thm"abs_add_one_gt_zero";
  49.312 -val abs_le_zero_iff = thm"abs_le_zero_iff";
  49.313 -val abs_real_of_nat_cancel = thm"abs_real_of_nat_cancel";
  49.314 -val abs_add_one_not_less_self = thm"abs_add_one_not_less_self";
  49.315 -val abs_sum_triangle_ineq = thm"abs_sum_triangle_ineq";
  49.316 -
  49.317 -val abs_mult_less = thm"abs_mult_less";
  49.318 -*}
  49.319 -
  49.320 -end
    50.1 --- a/src/HOL/Real/RealDef.thy	Sat Feb 14 02:06:12 2004 +0100
    50.2 +++ b/src/HOL/Real/RealDef.thy	Sun Feb 15 10:46:37 2004 +0100
    50.3 @@ -2,10 +2,13 @@
    50.4      ID          : $Id$
    50.5      Author      : Jacques D. Fleuriot
    50.6      Copyright   : 1998  University of Cambridge
    50.7 -    Description : The reals
    50.8 +    Conversion to Isar and new proofs by Lawrence C Paulson, 2003/4
    50.9  *)
   50.10  
   50.11 -theory RealDef = PReal:
   50.12 +header{*Defining the Reals from the Positive Reals*}
   50.13 +
   50.14 +theory RealDef = PReal
   50.15 +files ("real_arith.ML"):
   50.16  
   50.17  constdefs
   50.18    realrel   ::  "((preal * preal) * (preal * preal)) set"
   50.19 @@ -418,7 +421,7 @@
   50.20    "(Abs_REAL(realrel``{(x1,y1)}) \<le> Abs_REAL(realrel``{(x2,y2)})) =  
   50.21     (x1 + y2 \<le> x2 + y1)"
   50.22  apply (simp add: real_le_def) 
   50.23 -apply (auto intro: real_le_lemma);
   50.24 +apply (auto intro: real_le_lemma)
   50.25  done
   50.26  
   50.27  lemma real_le_anti_sym: "[| z \<le> w; w \<le> z |] ==> z = (w::real)"
   50.28 @@ -464,8 +467,7 @@
   50.29  apply (rule eq_Abs_REAL [of z])
   50.30  apply (rule eq_Abs_REAL [of w]) 
   50.31  apply (auto simp add: real_le real_zero_def preal_add_ac preal_cancels)
   50.32 -apply (cut_tac x="x+ya" and y="xa+y" in linorder_linear) 
   50.33 -apply (auto ); 
   50.34 +apply (cut_tac x="x+ya" and y="xa+y" in linorder_linear, auto) 
   50.35  done
   50.36  
   50.37  
   50.38 @@ -514,9 +516,8 @@
   50.39  
   50.40  text{*lemma for proving @{term "0<(1::real)"}*}
   50.41  lemma real_zero_le_one: "0 \<le> (1::real)"
   50.42 -apply (simp add: real_zero_def real_one_def real_le 
   50.43 +by (simp add: real_zero_def real_one_def real_le 
   50.44                   preal_self_less_add_left order_less_imp_le)
   50.45 -done
   50.46  
   50.47  
   50.48  subsection{*The Reals Form an Ordered Field*}
   50.49 @@ -792,7 +793,7 @@
   50.50  lemma real_of_nat_inject [iff]: "(real (n::nat) = real m) = (n = m)"
   50.51  by (simp add: real_of_nat_def)
   50.52  
   50.53 -lemma real_of_nat_zero_iff: "(real (n::nat) = 0) = (n = 0)"
   50.54 +lemma real_of_nat_zero_iff [iff]: "(real (n::nat) = 0) = (n = 0)"
   50.55  by (simp add: real_of_nat_def)
   50.56  
   50.57  lemma real_of_nat_diff: "n \<le> m ==> real (m - n) = real (m::nat) - real n"
   50.58 @@ -814,8 +815,7 @@
   50.59  by (simp add: real_of_nat_def real_of_int_def int_eq_of_nat)
   50.60  
   50.61  
   50.62 -
   50.63 -text{*Still needed for binary arith*}
   50.64 +text{*Still needed for binary arithmetic*}
   50.65  lemma real_of_nat_real_of_int: "~neg z ==> real (nat z) = real z"
   50.66  proof (simp add: not_neg_eq_ge_0 real_of_nat_def real_of_int_def)
   50.67    assume "0 \<le> z"
   50.68 @@ -826,107 +826,194 @@
   50.69    finally show "of_nat (nat z) = of_int z" .
   50.70  qed
   50.71  
   50.72 +
   50.73 +
   50.74 +subsection{*Numerals and Arithmetic*}
   50.75 +
   50.76 +instance real :: number ..
   50.77 +
   50.78 +primrec (*the type constraint is essential!*)
   50.79 +  number_of_Pls: "number_of bin.Pls = 0"
   50.80 +  number_of_Min: "number_of bin.Min = - (1::real)"
   50.81 +  number_of_BIT: "number_of(w BIT x) = (if x then 1 else 0) +
   50.82 +	                               (number_of w) + (number_of w)"
   50.83 +
   50.84 +declare number_of_Pls [simp del]
   50.85 +        number_of_Min [simp del]
   50.86 +        number_of_BIT [simp del]
   50.87 +
   50.88 +instance real :: number_ring
   50.89 +proof
   50.90 +  show "Numeral0 = (0::real)" by (rule number_of_Pls)
   50.91 +  show "-1 = - (1::real)" by (rule number_of_Min)
   50.92 +  fix w :: bin and x :: bool
   50.93 +  show "(number_of (w BIT x) :: real) =
   50.94 +        (if x then 1 else 0) + number_of w + number_of w"
   50.95 +    by (rule number_of_BIT)
   50.96 +qed
   50.97 +
   50.98 +
   50.99 +text{*Collapse applications of @{term real} to @{term number_of}*}
  50.100 +lemma real_number_of [simp]: "real (number_of v :: int) = number_of v"
  50.101 +by (simp add:  real_of_int_def of_int_number_of_eq)
  50.102 +
  50.103 +lemma real_of_nat_number_of [simp]:
  50.104 +     "real (number_of v :: nat) =  
  50.105 +        (if neg (number_of v :: int) then 0  
  50.106 +         else (number_of v :: real))"
  50.107 +by (simp add: real_of_int_real_of_nat [symmetric] int_nat_number_of)
  50.108 + 
  50.109 +
  50.110 +use "real_arith.ML"
  50.111 +
  50.112 +setup real_arith_setup
  50.113 +
  50.114 +subsection{* Simprules combining x+y and 0: ARE THEY NEEDED?*}
  50.115 +
  50.116 +text{*Needed in this non-standard form by Hyperreal/Transcendental*}
  50.117 +lemma real_0_le_divide_iff:
  50.118 +     "((0::real) \<le> x/y) = ((x \<le> 0 | 0 \<le> y) & (0 \<le> x | y \<le> 0))"
  50.119 +by (simp add: real_divide_def zero_le_mult_iff, auto)
  50.120 +
  50.121 +lemma real_add_minus_iff [simp]: "(x + - a = (0::real)) = (x=a)" 
  50.122 +by arith
  50.123 +
  50.124 +lemma real_add_eq_0_iff [iff]: "(x+y = (0::real)) = (y = -x)"
  50.125 +by auto
  50.126 +
  50.127 +lemma real_add_less_0_iff [iff]: "(x+y < (0::real)) = (y < -x)"
  50.128 +by auto
  50.129 +
  50.130 +lemma real_0_less_add_iff [iff]: "((0::real) < x+y) = (-x < y)"
  50.131 +by auto
  50.132 +
  50.133 +lemma real_add_le_0_iff [iff]: "(x+y \<le> (0::real)) = (y \<le> -x)"
  50.134 +by auto
  50.135 +
  50.136 +lemma real_0_le_add_iff [iff]: "((0::real) \<le> x+y) = (-x \<le> y)"
  50.137 +by auto
  50.138 +
  50.139 +
  50.140 +(** Simprules combining x-y and 0 (needed??) **)
  50.141 +
  50.142 +lemma real_0_less_diff_iff [iff]: "((0::real) < x-y) = (y < x)"
  50.143 +by auto
  50.144 +
  50.145 +lemma real_0_le_diff_iff [iff]: "((0::real) \<le> x-y) = (y \<le> x)"
  50.146 +by auto
  50.147 +
  50.148 +(*
  50.149 +FIXME: we should have this, as for type int, but many proofs would break.
  50.150 +It replaces x+-y by x-y.
  50.151 +Addsimps [symmetric real_diff_def]
  50.152 +*)
  50.153 +
  50.154 +
  50.155 +subsubsection{*Density of the Reals*}
  50.156 +
  50.157 +lemma real_lbound_gt_zero:
  50.158 +     "[| (0::real) < d1; 0 < d2 |] ==> \<exists>e. 0 < e & e < d1 & e < d2"
  50.159 +apply (rule_tac x = " (min d1 d2) /2" in exI)
  50.160 +apply (simp add: min_def)
  50.161 +done
  50.162 +
  50.163 +
  50.164 +text{*Similar results are proved in @{text Ring_and_Field}*}
  50.165 +lemma real_less_half_sum: "x < y ==> x < (x+y) / (2::real)"
  50.166 +  by auto
  50.167 +
  50.168 +lemma real_gt_half_sum: "x < y ==> (x+y)/(2::real) < y"
  50.169 +  by auto
  50.170 +
  50.171 +lemma real_dense: "x < y ==> \<exists>r::real. x < r & r < y"
  50.172 +  by (rule Ring_and_Field.dense)
  50.173 +
  50.174 +
  50.175 +subsection{*Absolute Value Function for the Reals*}
  50.176 +
  50.177 +text{*FIXME: these should go!*}
  50.178 +lemma abs_eqI1: "(0::real)\<le>x ==> abs x = x"
  50.179 +by (unfold real_abs_def, simp)
  50.180 +
  50.181 +lemma abs_eqI2: "(0::real) < x ==> abs x = x"
  50.182 +by (unfold real_abs_def, simp)
  50.183 +
  50.184 +lemma abs_minus_eqI2: "x < (0::real) ==> abs x = -x"
  50.185 +by (simp add: real_abs_def linorder_not_less [symmetric])
  50.186 +
  50.187 +lemma abs_minus_add_cancel: "abs(x + (-y)) = abs (y + (-(x::real)))"
  50.188 +by (unfold real_abs_def, simp)
  50.189 +
  50.190 +lemma abs_minus_one [simp]: "abs (-1) = (1::real)"
  50.191 +by (unfold real_abs_def, simp)
  50.192 +
  50.193 +lemma abs_interval_iff: "(abs x < r) = (-r < x & x < (r::real))"
  50.194 +by (force simp add: Ring_and_Field.abs_less_iff)
  50.195 +
  50.196 +lemma abs_le_interval_iff: "(abs x \<le> r) = (-r\<le>x & x\<le>(r::real))"
  50.197 +by (force simp add: Ring_and_Field.abs_le_iff)
  50.198 +
  50.199 +lemma abs_add_one_gt_zero [simp]: "(0::real) < 1 + abs(x)"
  50.200 +by (unfold real_abs_def, auto)
  50.201 +
  50.202 +lemma abs_real_of_nat_cancel [simp]: "abs (real x) = real (x::nat)"
  50.203 +by (auto intro: abs_eqI1 simp add: real_of_nat_ge_zero)
  50.204 +
  50.205 +lemma abs_add_one_not_less_self [simp]: "~ abs(x) + (1::real) < x"
  50.206 +apply (simp add: linorder_not_less)
  50.207 +apply (auto intro: abs_ge_self [THEN order_trans])
  50.208 +done
  50.209 + 
  50.210 +text{*Used only in Hyperreal/Lim.ML*}
  50.211 +lemma abs_sum_triangle_ineq: "abs ((x::real) + y + (-l + -m)) \<le> abs(x + -l) + abs(y + -m)"
  50.212 +apply (simp add: real_add_assoc)
  50.213 +apply (rule_tac a1 = y in add_left_commute [THEN ssubst])
  50.214 +apply (rule real_add_assoc [THEN subst])
  50.215 +apply (rule abs_triangle_ineq)
  50.216 +done
  50.217 +
  50.218 +
  50.219 +
  50.220  ML
  50.221  {*
  50.222 -val real_abs_def = thm "real_abs_def";
  50.223 -
  50.224 -val real_le_def = thm "real_le_def";
  50.225 -val real_diff_def = thm "real_diff_def";
  50.226 -val real_divide_def = thm "real_divide_def";
  50.227 -
  50.228 -val realrel_iff = thm"realrel_iff";
  50.229 -val realrel_refl = thm"realrel_refl";
  50.230 -val equiv_realrel = thm"equiv_realrel";
  50.231 -val equiv_realrel_iff = thm"equiv_realrel_iff";
  50.232 -val realrel_in_real = thm"realrel_in_real";
  50.233 -val inj_on_Abs_REAL = thm"inj_on_Abs_REAL";
  50.234 -val eq_realrelD = thm"eq_realrelD";
  50.235 -val inj_Rep_REAL = thm"inj_Rep_REAL";
  50.236 -val inj_real_of_preal = thm"inj_real_of_preal";
  50.237 -val eq_Abs_REAL = thm"eq_Abs_REAL";
  50.238 -val real_minus_congruent = thm"real_minus_congruent";
  50.239 -val real_minus = thm"real_minus";
  50.240 -val real_add = thm"real_add";
  50.241 -val real_add_commute = thm"real_add_commute";
  50.242 -val real_add_assoc = thm"real_add_assoc";
  50.243 -val real_add_zero_left = thm"real_add_zero_left";
  50.244 -val real_add_zero_right = thm"real_add_zero_right";
  50.245 +val real_0_le_divide_iff = thm"real_0_le_divide_iff";
  50.246 +val real_add_minus_iff = thm"real_add_minus_iff";
  50.247 +val real_add_eq_0_iff = thm"real_add_eq_0_iff";
  50.248 +val real_add_less_0_iff = thm"real_add_less_0_iff";
  50.249 +val real_0_less_add_iff = thm"real_0_less_add_iff";
  50.250 +val real_add_le_0_iff = thm"real_add_le_0_iff";
  50.251 +val real_0_le_add_iff = thm"real_0_le_add_iff";
  50.252 +val real_0_less_diff_iff = thm"real_0_less_diff_iff";
  50.253 +val real_0_le_diff_iff = thm"real_0_le_diff_iff";
  50.254 +val real_lbound_gt_zero = thm"real_lbound_gt_zero";
  50.255 +val real_less_half_sum = thm"real_less_half_sum";
  50.256 +val real_gt_half_sum = thm"real_gt_half_sum";
  50.257 +val real_dense = thm"real_dense";
  50.258  
  50.259 -val real_mult = thm"real_mult";
  50.260 -val real_mult_commute = thm"real_mult_commute";
  50.261 -val real_mult_assoc = thm"real_mult_assoc";
  50.262 -val real_mult_1 = thm"real_mult_1";
  50.263 -val real_mult_1_right = thm"real_mult_1_right";
  50.264 -val preal_le_linear = thm"preal_le_linear";
  50.265 -val real_mult_inverse_left = thm"real_mult_inverse_left";
  50.266 -val real_not_refl2 = thm"real_not_refl2";
  50.267 -val real_of_preal_add = thm"real_of_preal_add";
  50.268 -val real_of_preal_mult = thm"real_of_preal_mult";
  50.269 -val real_of_preal_trichotomy = thm"real_of_preal_trichotomy";
  50.270 -val real_of_preal_minus_less_zero = thm"real_of_preal_minus_less_zero";
  50.271 -val real_of_preal_not_minus_gt_zero = thm"real_of_preal_not_minus_gt_zero";
  50.272 -val real_of_preal_zero_less = thm"real_of_preal_zero_less";
  50.273 -val real_le_imp_less_or_eq = thm"real_le_imp_less_or_eq";
  50.274 -val real_le_refl = thm"real_le_refl";
  50.275 -val real_le_linear = thm"real_le_linear";
  50.276 -val real_le_trans = thm"real_le_trans";
  50.277 -val real_le_anti_sym = thm"real_le_anti_sym";
  50.278 -val real_less_le = thm"real_less_le";
  50.279 -val real_less_sum_gt_zero = thm"real_less_sum_gt_zero";
  50.280 -val real_gt_zero_preal_Ex = thm "real_gt_zero_preal_Ex";
  50.281 -val real_gt_preal_preal_Ex = thm "real_gt_preal_preal_Ex";
  50.282 -val real_ge_preal_preal_Ex = thm "real_ge_preal_preal_Ex";
  50.283 -val real_less_all_preal = thm "real_less_all_preal";
  50.284 -val real_less_all_real2 = thm "real_less_all_real2";
  50.285 -val real_of_preal_le_iff = thm "real_of_preal_le_iff";
  50.286 -val real_mult_order = thm "real_mult_order";
  50.287 -val real_zero_less_one = thm "real_zero_less_one";
  50.288 -val real_add_less_le_mono = thm "real_add_less_le_mono";
  50.289 -val real_add_le_less_mono = thm "real_add_le_less_mono";
  50.290 -val real_add_order = thm "real_add_order";
  50.291 -val real_le_add_order = thm "real_le_add_order";
  50.292 -val real_le_square = thm "real_le_square";
  50.293 -val real_mult_less_mono2 = thm "real_mult_less_mono2";
  50.294 +val abs_eqI1 = thm"abs_eqI1";
  50.295 +val abs_eqI2 = thm"abs_eqI2";
  50.296 +val abs_minus_eqI2 = thm"abs_minus_eqI2";
  50.297 +val abs_ge_zero = thm"abs_ge_zero";
  50.298 +val abs_idempotent = thm"abs_idempotent";
  50.299 +val abs_zero_iff = thm"abs_zero_iff";
  50.300 +val abs_ge_self = thm"abs_ge_self";
  50.301 +val abs_ge_minus_self = thm"abs_ge_minus_self";
  50.302 +val abs_mult = thm"abs_mult";
  50.303 +val abs_inverse = thm"abs_inverse";
  50.304 +val abs_triangle_ineq = thm"abs_triangle_ineq";
  50.305 +val abs_minus_cancel = thm"abs_minus_cancel";
  50.306 +val abs_minus_add_cancel = thm"abs_minus_add_cancel";
  50.307 +val abs_minus_one = thm"abs_minus_one";
  50.308 +val abs_interval_iff = thm"abs_interval_iff";
  50.309 +val abs_le_interval_iff = thm"abs_le_interval_iff";
  50.310 +val abs_add_one_gt_zero = thm"abs_add_one_gt_zero";
  50.311 +val abs_le_zero_iff = thm"abs_le_zero_iff";
  50.312 +val abs_real_of_nat_cancel = thm"abs_real_of_nat_cancel";
  50.313 +val abs_add_one_not_less_self = thm"abs_add_one_not_less_self";
  50.314 +val abs_sum_triangle_ineq = thm"abs_sum_triangle_ineq";
  50.315  
  50.316 -val real_mult_less_iff1 = thm "real_mult_less_iff1";
  50.317 -val real_mult_le_cancel_iff1 = thm "real_mult_le_cancel_iff1";
  50.318 -val real_mult_le_cancel_iff2 = thm "real_mult_le_cancel_iff2";
  50.319 -val real_mult_less_mono = thm "real_mult_less_mono";
  50.320 -val real_mult_less_mono' = thm "real_mult_less_mono'";
  50.321 -val real_sum_squares_cancel = thm "real_sum_squares_cancel";
  50.322 -val real_sum_squares_cancel2 = thm "real_sum_squares_cancel2";
  50.323 -
  50.324 -val real_mult_left_cancel = thm"real_mult_left_cancel";
  50.325 -val real_mult_right_cancel = thm"real_mult_right_cancel";
  50.326 -val real_inverse_unique = thm "real_inverse_unique";
  50.327 -val real_inverse_gt_one = thm "real_inverse_gt_one";
  50.328 -
  50.329 -val real_of_int_zero = thm"real_of_int_zero";
  50.330 -val real_of_one = thm"real_of_one";
  50.331 -val real_of_int_add = thm"real_of_int_add";
  50.332 -val real_of_int_minus = thm"real_of_int_minus";
  50.333 -val real_of_int_diff = thm"real_of_int_diff";
  50.334 -val real_of_int_mult = thm"real_of_int_mult";
  50.335 -val real_of_int_real_of_nat = thm"real_of_int_real_of_nat";
  50.336 -val real_of_int_inject = thm"real_of_int_inject";
  50.337 -val real_of_int_less_iff = thm"real_of_int_less_iff";
  50.338 -val real_of_int_le_iff = thm"real_of_int_le_iff";
  50.339 -val real_of_nat_zero = thm "real_of_nat_zero";
  50.340 -val real_of_nat_one = thm "real_of_nat_one";
  50.341 -val real_of_nat_add = thm "real_of_nat_add";
  50.342 -val real_of_nat_Suc = thm "real_of_nat_Suc";
  50.343 -val real_of_nat_less_iff = thm "real_of_nat_less_iff";
  50.344 -val real_of_nat_le_iff = thm "real_of_nat_le_iff";
  50.345 -val real_of_nat_ge_zero = thm "real_of_nat_ge_zero";
  50.346 -val real_of_nat_Suc_gt_zero = thm "real_of_nat_Suc_gt_zero";
  50.347 -val real_of_nat_mult = thm "real_of_nat_mult";
  50.348 -val real_of_nat_inject = thm "real_of_nat_inject";
  50.349 -val real_of_nat_diff = thm "real_of_nat_diff";
  50.350 -val real_of_nat_zero_iff = thm "real_of_nat_zero_iff";
  50.351 -val real_of_nat_gt_zero_cancel_iff = thm "real_of_nat_gt_zero_cancel_iff";
  50.352 -val real_of_nat_le_zero_cancel_iff = thm "real_of_nat_le_zero_cancel_iff";
  50.353 -val not_real_of_nat_less_zero = thm "not_real_of_nat_less_zero";
  50.354 -val real_of_nat_ge_zero_cancel_iff = thm "real_of_nat_ge_zero_cancel_iff";
  50.355 +val abs_mult_less = thm"abs_mult_less";
  50.356  *}
  50.357  
  50.358 +
  50.359  end
    51.1 --- a/src/HOL/Real/RealPow.thy	Sat Feb 14 02:06:12 2004 +0100
    51.2 +++ b/src/HOL/Real/RealPow.thy	Sun Feb 15 10:46:37 2004 +0100
    51.3 @@ -6,7 +6,7 @@
    51.4  
    51.5  *)
    51.6  
    51.7 -theory RealPow = RealArith:
    51.8 +theory RealPow = RealDef:
    51.9  
   51.10  declare abs_mult_self [simp]
   51.11  
   51.12 @@ -60,7 +60,7 @@
   51.13  lemma two_realpow_gt [simp]: "real (n::nat) < 2 ^ n"
   51.14  apply (induct_tac "n")
   51.15  apply (auto simp add: real_of_nat_Suc)
   51.16 -apply (subst real_mult_2)
   51.17 +apply (subst mult_2)
   51.18  apply (rule real_add_less_le_mono)
   51.19  apply (auto simp add: two_realpow_ge_one)
   51.20  done
   51.21 @@ -137,13 +137,13 @@
   51.22  
   51.23  lemma real_of_int_power: "real (x::int) ^ n = real (x ^ n)"
   51.24  apply (induct_tac "n")
   51.25 -apply (simp_all (no_asm_simp) add: nat_mult_distrib)
   51.26 +apply (simp_all add: nat_mult_distrib)
   51.27  done
   51.28  declare real_of_int_power [symmetric, simp]
   51.29  
   51.30  lemma power_real_number_of:
   51.31       "(number_of v :: real) ^ n = real ((number_of v :: int) ^ n)"
   51.32 -by (simp only: real_number_of_def real_of_int_power)
   51.33 +by (simp only: real_number_of [symmetric] real_of_int_power)
   51.34  
   51.35  declare power_real_number_of [of _ "number_of w", standard, simp]
   51.36  
   51.37 @@ -254,6 +254,7 @@
   51.38  apply (auto simp add: realpow_num_eq_if)
   51.39  done
   51.40  
   51.41 +(*???generalize the type!*)
   51.42  lemma zero_le_x_squared [simp]: "(0::real) \<le> x^2"
   51.43  by (simp add: power2_eq_square)
   51.44  
    52.1 --- a/src/HOL/Real/rat_arith.ML	Sat Feb 14 02:06:12 2004 +0100
    52.2 +++ b/src/HOL/Real/rat_arith.ML	Sun Feb 15 10:46:37 2004 +0100
    52.3 @@ -13,352 +13,9 @@
    52.4      read_instantiate_sg(sign_of (the_context())) [("a","?a::rat")] mult_strict_left_mono;
    52.5  
    52.6  val rat_mult_left_mono =
    52.7 -    read_instantiate_sg(sign_of (the_context())) [("a","?a::rat")] mult_left_mono;
    52.8 -
    52.9 -
   52.10 -val rat_number_of_def = thm "rat_number_of_def";
   52.11 -val diff_rat_def = thm "diff_rat_def";
   52.12 -
   52.13 -val rat_numeral_0_eq_0 = thm "rat_numeral_0_eq_0";
   52.14 -val rat_numeral_1_eq_1 = thm "rat_numeral_1_eq_1";
   52.15 -val add_rat_number_of = thm "add_rat_number_of";
   52.16 -val minus_rat_number_of = thm "minus_rat_number_of";
   52.17 -val diff_rat_number_of = thm "diff_rat_number_of";
   52.18 -val mult_rat_number_of = thm "mult_rat_number_of";
   52.19 -val rat_mult_2 = thm "rat_mult_2";
   52.20 -val rat_mult_2_right = thm "rat_mult_2_right";
   52.21 -val eq_rat_number_of = thm "eq_rat_number_of";
   52.22 -val less_rat_number_of = thm "less_rat_number_of";
   52.23 -val rat_minus_1_eq_m1 = thm "rat_minus_1_eq_m1";
   52.24 -val rat_mult_minus1 = thm "rat_mult_minus1";
   52.25 -val rat_mult_minus1_right = thm "rat_mult_minus1_right";
   52.26 -val rat_add_number_of_left = thm "rat_add_number_of_left";
   52.27 -val rat_mult_number_of_left = thm "rat_mult_number_of_left";
   52.28 -val rat_add_number_of_diff1 = thm "rat_add_number_of_diff1";
   52.29 -val rat_add_number_of_diff2 = thm "rat_add_number_of_diff2";
   52.30 -
   52.31 -val rat_add_0_left = thm "rat_add_0_left";
   52.32 -val rat_add_0_right = thm "rat_add_0_right";
   52.33 -val rat_mult_1_left = thm "rat_mult_1_left";
   52.34 -val rat_mult_1_right = thm "rat_mult_1_right";
   52.35 -
   52.36 -(*Maps 0 to Numeral0 and 1 to Numeral1 and -(Numeral1) to -1*)
   52.37 -val rat_numeral_ss =
   52.38 -    HOL_ss addsimps [rat_numeral_0_eq_0 RS sym, rat_numeral_1_eq_1 RS sym,
   52.39 -                     rat_minus_1_eq_m1];
   52.40 -
   52.41 -fun rename_numerals th =
   52.42 -    asm_full_simplify rat_numeral_ss (Thm.transfer (the_context ()) th);
   52.43 -
   52.44 -
   52.45 -structure Rat_Numeral_Simprocs =
   52.46 -struct
   52.47 -
   52.48 -(*Maps 0 to Numeral0 and 1 to Numeral1 so that arithmetic in simprocs
   52.49 -  isn't complicated by the abstract 0 and 1.*)
   52.50 -val numeral_syms = [rat_numeral_0_eq_0 RS sym, rat_numeral_1_eq_1 RS sym];
   52.51 -
   52.52 -(*Utilities*)
   52.53 -
   52.54 -val ratT = Type("Rational.rat", []);
   52.55 -
   52.56 -fun mk_numeral n = HOLogic.number_of_const ratT $ HOLogic.mk_bin n;
   52.57 -
   52.58 -(*Decodes a binary rat constant, or 0, 1*)
   52.59 -val dest_numeral = Int_Numeral_Simprocs.dest_numeral;
   52.60 -val find_first_numeral = Int_Numeral_Simprocs.find_first_numeral;
   52.61 -
   52.62 -val zero = mk_numeral 0;
   52.63 -val mk_plus = HOLogic.mk_binop "op +";
   52.64 -
   52.65 -val uminus_const = Const ("uminus", ratT --> ratT);
   52.66 -
   52.67 -(*Thus mk_sum[t] yields t+0; longer sums don't have a trailing zero*)
   52.68 -fun mk_sum []        = zero
   52.69 -  | mk_sum [t,u]     = mk_plus (t, u)
   52.70 -  | mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
   52.71 -
   52.72 -(*this version ALWAYS includes a trailing zero*)
   52.73 -fun long_mk_sum []        = zero
   52.74 -  | long_mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
   52.75 -
   52.76 -val dest_plus = HOLogic.dest_bin "op +" ratT;
   52.77 -
   52.78 -(*decompose additions AND subtractions as a sum*)
   52.79 -fun dest_summing (pos, Const ("op +", _) $ t $ u, ts) =
   52.80 -        dest_summing (pos, t, dest_summing (pos, u, ts))
   52.81 -  | dest_summing (pos, Const ("op -", _) $ t $ u, ts) =
   52.82 -        dest_summing (pos, t, dest_summing (not pos, u, ts))
   52.83 -  | dest_summing (pos, t, ts) =
   52.84 -        if pos then t::ts else uminus_const$t :: ts;
   52.85 -
   52.86 -fun dest_sum t = dest_summing (true, t, []);
   52.87 -
   52.88 -val mk_diff = HOLogic.mk_binop "op -";
   52.89 -val dest_diff = HOLogic.dest_bin "op -" ratT;
   52.90 -
   52.91 -val one = mk_numeral 1;
   52.92 -val mk_times = HOLogic.mk_binop "op *";
   52.93 -
   52.94 -fun mk_prod [] = one
   52.95 -  | mk_prod [t] = t
   52.96 -  | mk_prod (t :: ts) = if t = one then mk_prod ts
   52.97 -                        else mk_times (t, mk_prod ts);
   52.98 -
   52.99 -val dest_times = HOLogic.dest_bin "op *" ratT;
  52.100 -
  52.101 -fun dest_prod t =
  52.102 -      let val (t,u) = dest_times t
  52.103 -      in  dest_prod t @ dest_prod u  end
  52.104 -      handle TERM _ => [t];
  52.105 -
  52.106 -(*DON'T do the obvious simplifications; that would create special cases*)
  52.107 -fun mk_coeff (k, ts) = mk_times (mk_numeral k, ts);
  52.108 -
  52.109 -(*Express t as a product of (possibly) a numeral with other sorted terms*)
  52.110 -fun dest_coeff sign (Const ("uminus", _) $ t) = dest_coeff (~sign) t
  52.111 -  | dest_coeff sign t =
  52.112 -    let val ts = sort Term.term_ord (dest_prod t)
  52.113 -        val (n, ts') = find_first_numeral [] ts
  52.114 -                          handle TERM _ => (1, ts)
  52.115 -    in (sign*n, mk_prod ts') end;
  52.116 -
  52.117 -(*Find first coefficient-term THAT MATCHES u*)
  52.118 -fun find_first_coeff past u [] = raise TERM("find_first_coeff", [])
  52.119 -  | find_first_coeff past u (t::terms) =
  52.120 -        let val (n,u') = dest_coeff 1 t
  52.121 -        in  if u aconv u' then (n, rev past @ terms)
  52.122 -                          else find_first_coeff (t::past) u terms
  52.123 -        end
  52.124 -        handle TERM _ => find_first_coeff (t::past) u terms;
  52.125 -
  52.126 -
  52.127 -(*Simplify Numeral0+n, n+Numeral0, Numeral1*n, n*Numeral1*)
  52.128 -val add_0s  = map rename_numerals [rat_add_0_left, rat_add_0_right];
  52.129 -val mult_1s = map rename_numerals [rat_mult_1_left, rat_mult_1_right] @
  52.130 -              [rat_mult_minus1, rat_mult_minus1_right];
  52.131 -
  52.132 -(*To perform binary arithmetic*)
  52.133 -val bin_simps =
  52.134 -    [rat_numeral_0_eq_0 RS sym, rat_numeral_1_eq_1 RS sym,
  52.135 -     add_rat_number_of, rat_add_number_of_left, minus_rat_number_of,
  52.136 -     diff_rat_number_of, mult_rat_number_of, rat_mult_number_of_left] @
  52.137 -    bin_arith_simps @ bin_rel_simps;
  52.138 -
  52.139 -(*Binary arithmetic BUT NOT ADDITION since it may collapse adjacent terms
  52.140 -  during re-arrangement*)
  52.141 -val non_add_bin_simps = 
  52.142 -    bin_simps \\ [rat_add_number_of_left, add_rat_number_of];
  52.143 -
  52.144 -(*To evaluate binary negations of coefficients*)
  52.145 -val rat_minus_simps = NCons_simps @
  52.146 -                   [rat_minus_1_eq_m1, minus_rat_number_of,
  52.147 -                    bin_minus_1, bin_minus_0, bin_minus_Pls, bin_minus_Min,
  52.148 -                    bin_pred_1, bin_pred_0, bin_pred_Pls, bin_pred_Min];
  52.149 -
  52.150 -(*To let us treat subtraction as addition*)
  52.151 -val diff_simps = [diff_rat_def, minus_add_distrib, minus_minus];
  52.152 -
  52.153 -(*to extract again any uncancelled minuses*)
  52.154 -val rat_minus_from_mult_simps =
  52.155 -    [minus_minus, minus_mult_left RS sym, minus_mult_right RS sym];
  52.156 -
  52.157 -(*combine unary minus with numeric literals, however nested within a product*)
  52.158 -val rat_mult_minus_simps =
  52.159 -    [mult_assoc, minus_mult_left, minus_mult_commute];
  52.160 -
  52.161 -(*Apply the given rewrite (if present) just once*)
  52.162 -fun trans_tac None      = all_tac
  52.163 -  | trans_tac (Some th) = ALLGOALS (rtac (th RS trans));
  52.164 -
  52.165 -(*Final simplification: cancel + and *  *)
  52.166 -val simplify_meta_eq =
  52.167 -    Int_Numeral_Simprocs.simplify_meta_eq
  52.168 -         [add_0, add_0_right,
  52.169 -          mult_zero_left, mult_zero_right, mult_1, mult_1_right];
  52.170 -
  52.171 -fun prep_simproc (name, pats, proc) =
  52.172 -  Simplifier.simproc (Theory.sign_of (the_context ())) name pats proc;
  52.173 + read_instantiate_sg(sign_of (the_context())) [("a","?a::rat")] mult_left_mono;
  52.174  
  52.175 -structure CancelNumeralsCommon =
  52.176 -  struct
  52.177 -  val mk_sum            = mk_sum
  52.178 -  val dest_sum          = dest_sum
  52.179 -  val mk_coeff          = mk_coeff
  52.180 -  val dest_coeff        = dest_coeff 1
  52.181 -  val find_first_coeff  = find_first_coeff []
  52.182 -  val trans_tac         = trans_tac
  52.183 -  val norm_tac =
  52.184 -     ALLGOALS (simp_tac (HOL_ss addsimps add_0s@mult_1s@diff_simps@
  52.185 -                                         rat_minus_simps@add_ac))
  52.186 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps non_add_bin_simps@rat_mult_minus_simps))
  52.187 -     THEN ALLGOALS
  52.188 -              (simp_tac (HOL_ss addsimps rat_minus_from_mult_simps@
  52.189 -                                         add_ac@mult_ac))
  52.190 -  val numeral_simp_tac  = ALLGOALS (simp_tac (HOL_ss addsimps add_0s@bin_simps))
  52.191 -  val simplify_meta_eq  = simplify_meta_eq
  52.192 -  end;
  52.193 -
  52.194 -
  52.195 -structure EqCancelNumerals = CancelNumeralsFun
  52.196 - (open CancelNumeralsCommon
  52.197 -  val prove_conv = Bin_Simprocs.prove_conv
  52.198 -  val mk_bal   = HOLogic.mk_eq
  52.199 -  val dest_bal = HOLogic.dest_bin "op =" ratT
  52.200 -  val bal_add1 = eq_add_iff1 RS trans
  52.201 -  val bal_add2 = eq_add_iff2 RS trans
  52.202 -);
  52.203 -
  52.204 -structure LessCancelNumerals = CancelNumeralsFun
  52.205 - (open CancelNumeralsCommon
  52.206 -  val prove_conv = Bin_Simprocs.prove_conv
  52.207 -  val mk_bal   = HOLogic.mk_binrel "op <"
  52.208 -  val dest_bal = HOLogic.dest_bin "op <" ratT
  52.209 -  val bal_add1 = less_add_iff1 RS trans
  52.210 -  val bal_add2 = less_add_iff2 RS trans
  52.211 -);
  52.212 -
  52.213 -structure LeCancelNumerals = CancelNumeralsFun
  52.214 - (open CancelNumeralsCommon
  52.215 -  val prove_conv = Bin_Simprocs.prove_conv
  52.216 -  val mk_bal   = HOLogic.mk_binrel "op <="
  52.217 -  val dest_bal = HOLogic.dest_bin "op <=" ratT
  52.218 -  val bal_add1 = le_add_iff1 RS trans
  52.219 -  val bal_add2 = le_add_iff2 RS trans
  52.220 -);
  52.221 -
  52.222 -val cancel_numerals =
  52.223 -  map prep_simproc
  52.224 -   [("rateq_cancel_numerals",
  52.225 -     ["(l::rat) + m = n", "(l::rat) = m + n",
  52.226 -      "(l::rat) - m = n", "(l::rat) = m - n",
  52.227 -      "(l::rat) * m = n", "(l::rat) = m * n"],
  52.228 -     EqCancelNumerals.proc),
  52.229 -    ("ratless_cancel_numerals",
  52.230 -     ["(l::rat) + m < n", "(l::rat) < m + n",
  52.231 -      "(l::rat) - m < n", "(l::rat) < m - n",
  52.232 -      "(l::rat) * m < n", "(l::rat) < m * n"],
  52.233 -     LessCancelNumerals.proc),
  52.234 -    ("ratle_cancel_numerals",
  52.235 -     ["(l::rat) + m <= n", "(l::rat) <= m + n",
  52.236 -      "(l::rat) - m <= n", "(l::rat) <= m - n",
  52.237 -      "(l::rat) * m <= n", "(l::rat) <= m * n"],
  52.238 -     LeCancelNumerals.proc)];
  52.239 -
  52.240 -
  52.241 -structure CombineNumeralsData =
  52.242 -  struct
  52.243 -  val add               = op + : int*int -> int
  52.244 -  val mk_sum            = long_mk_sum    (*to work for e.g. 2*x + 3*x *)
  52.245 -  val dest_sum          = dest_sum
  52.246 -  val mk_coeff          = mk_coeff
  52.247 -  val dest_coeff        = dest_coeff 1
  52.248 -  val left_distrib      = combine_common_factor RS trans
  52.249 -  val prove_conv        = Bin_Simprocs.prove_conv_nohyps
  52.250 -  val trans_tac         = trans_tac
  52.251 -  val norm_tac =
  52.252 -     ALLGOALS (simp_tac (HOL_ss addsimps numeral_syms@add_0s@mult_1s@
  52.253 -                                   diff_simps@rat_minus_simps@add_ac))
  52.254 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps non_add_bin_simps@rat_mult_minus_simps))
  52.255 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps rat_minus_from_mult_simps@
  52.256 -                                              add_ac@mult_ac))
  52.257 -  val numeral_simp_tac  = ALLGOALS
  52.258 -                    (simp_tac (HOL_ss addsimps add_0s@bin_simps))
  52.259 -  val simplify_meta_eq  =
  52.260 -        Int_Numeral_Simprocs.simplify_meta_eq (add_0s@mult_1s)
  52.261 -  end;
  52.262 -
  52.263 -structure CombineNumerals = CombineNumeralsFun(CombineNumeralsData);
  52.264 -
  52.265 -val combine_numerals =
  52.266 -  prep_simproc ("rat_combine_numerals", ["(i::rat) + j", "(i::rat) - j"], CombineNumerals.proc);
  52.267 -
  52.268 -
  52.269 -(** Declarations for ExtractCommonTerm **)
  52.270 -
  52.271 -(*this version ALWAYS includes a trailing one*)
  52.272 -fun long_mk_prod []        = one
  52.273 -  | long_mk_prod (t :: ts) = mk_times (t, mk_prod ts);
  52.274 -
  52.275 -(*Find first term that matches u*)
  52.276 -fun find_first past u []         = raise TERM("find_first", [])
  52.277 -  | find_first past u (t::terms) =
  52.278 -        if u aconv t then (rev past @ terms)
  52.279 -        else find_first (t::past) u terms
  52.280 -        handle TERM _ => find_first (t::past) u terms;
  52.281 -
  52.282 -(*Final simplification: cancel + and *  *)
  52.283 -fun cancel_simplify_meta_eq cancel_th th =
  52.284 -    Int_Numeral_Simprocs.simplify_meta_eq
  52.285 -        [rat_mult_1_left, rat_mult_1_right]
  52.286 -        (([th, cancel_th]) MRS trans);
  52.287 -
  52.288 -(*** Making constant folding work for 0 and 1 too ***)
  52.289 -
  52.290 -structure RatAbstractNumeralsData =
  52.291 -  struct
  52.292 -  val dest_eq         = HOLogic.dest_eq o HOLogic.dest_Trueprop o concl_of
  52.293 -  val is_numeral      = Bin_Simprocs.is_numeral
  52.294 -  val numeral_0_eq_0  = rat_numeral_0_eq_0
  52.295 -  val numeral_1_eq_1  = rat_numeral_1_eq_1
  52.296 -  val prove_conv      = Bin_Simprocs.prove_conv_nohyps_novars
  52.297 -  fun norm_tac simps  = ALLGOALS (simp_tac (HOL_ss addsimps simps))
  52.298 -  val simplify_meta_eq = Bin_Simprocs.simplify_meta_eq
  52.299 -  end
  52.300 -
  52.301 -structure RatAbstractNumerals = AbstractNumeralsFun (RatAbstractNumeralsData)
  52.302 -
  52.303 -(*For addition, we already have rules for the operand 0.
  52.304 -  Multiplication is omitted because there are already special rules for
  52.305 -  both 0 and 1 as operands.  Unary minus is trivial, just have - 1 = -1.
  52.306 -  For the others, having three patterns is a compromise between just having
  52.307 -  one (many spurious calls) and having nine (just too many!) *)
  52.308 -val eval_numerals =
  52.309 -  map prep_simproc
  52.310 -   [("rat_add_eval_numerals",
  52.311 -     ["(m::rat) + 1", "(m::rat) + number_of v"],
  52.312 -     RatAbstractNumerals.proc add_rat_number_of),
  52.313 -    ("rat_diff_eval_numerals",
  52.314 -     ["(m::rat) - 1", "(m::rat) - number_of v"],
  52.315 -     RatAbstractNumerals.proc diff_rat_number_of),
  52.316 -    ("rat_eq_eval_numerals",
  52.317 -     ["(m::rat) = 0", "(m::rat) = 1", "(m::rat) = number_of v"],
  52.318 -     RatAbstractNumerals.proc eq_rat_number_of),
  52.319 -    ("rat_less_eval_numerals",
  52.320 -     ["(m::rat) < 0", "(m::rat) < 1", "(m::rat) < number_of v"],
  52.321 -     RatAbstractNumerals.proc less_rat_number_of),
  52.322 -    ("rat_le_eval_numerals",
  52.323 -     ["(m::rat) <= 0", "(m::rat) <= 1", "(m::rat) <= number_of v"],
  52.324 -     RatAbstractNumerals.proc le_number_of_eq_not_less)]
  52.325 -
  52.326 -end;
  52.327 -
  52.328 -
  52.329 -Addsimprocs Rat_Numeral_Simprocs.eval_numerals;
  52.330 -Addsimprocs Rat_Numeral_Simprocs.cancel_numerals;
  52.331 -Addsimprocs [Rat_Numeral_Simprocs.combine_numerals];
  52.332 -
  52.333 -
  52.334 -
  52.335 -(** Constant folding for rat plus and times **)
  52.336 -
  52.337 -(*We do not need
  52.338 -    structure Rat_Plus_Assoc = Assoc_Fold (Rat_Plus_Assoc_Data);
  52.339 -  because combine_numerals does the same thing*)
  52.340 -
  52.341 -structure Rat_Times_Assoc_Data : ASSOC_FOLD_DATA =
  52.342 -struct
  52.343 -  val ss                = HOL_ss
  52.344 -  val eq_reflection     = eq_reflection
  52.345 -  val sg_ref    = Sign.self_ref (Theory.sign_of (the_context ()))
  52.346 -  val T      = Rat_Numeral_Simprocs.ratT
  52.347 -  val plus   = Const ("op *", [Rat_Numeral_Simprocs.ratT,Rat_Numeral_Simprocs.ratT] ---> Rat_Numeral_Simprocs.ratT)
  52.348 -  val add_ac = mult_ac
  52.349 -end;
  52.350 -
  52.351 -structure Rat_Times_Assoc = Assoc_Fold (Rat_Times_Assoc_Data);
  52.352 -
  52.353 -Addsimprocs [Rat_Times_Assoc.conv];
  52.354 +	val le_number_of_eq = thm"le_number_of_eq";
  52.355  
  52.356  
  52.357  (****Common factor cancellation****)
  52.358 @@ -373,32 +30,33 @@
  52.359  and d = gcd(m,m') and n=m/d and n'=m'/d.
  52.360  *)
  52.361  
  52.362 -local
  52.363 -  open Rat_Numeral_Simprocs
  52.364 +val rel_number_of = [eq_number_of_eq, less_number_of_eq_neg, le_number_of_eq]
  52.365 +
  52.366 +local open Int_Numeral_Simprocs
  52.367  in
  52.368  
  52.369 -val rel_rat_number_of = [eq_rat_number_of, less_rat_number_of,
  52.370 -                          le_number_of_eq_not_less]
  52.371 -
  52.372  structure CancelNumeralFactorCommon =
  52.373    struct
  52.374    val mk_coeff          = mk_coeff
  52.375    val dest_coeff        = dest_coeff 1
  52.376    val trans_tac         = trans_tac
  52.377    val norm_tac =
  52.378 -     ALLGOALS (simp_tac (HOL_ss addsimps rat_minus_from_mult_simps @ mult_1s))
  52.379 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps bin_simps@rat_mult_minus_simps))
  52.380 +     ALLGOALS (simp_tac (HOL_ss addsimps minus_from_mult_simps @ mult_1s))
  52.381 +     THEN ALLGOALS (simp_tac (HOL_ss addsimps bin_simps@mult_minus_simps))
  52.382       THEN ALLGOALS (simp_tac (HOL_ss addsimps mult_ac))
  52.383    val numeral_simp_tac  =
  52.384 -         ALLGOALS (simp_tac (HOL_ss addsimps rel_rat_number_of@bin_simps))
  52.385 -  val simplify_meta_eq  = simplify_meta_eq
  52.386 +         ALLGOALS (simp_tac (HOL_ss addsimps rel_number_of@bin_simps))
  52.387 +  val simplify_meta_eq  = 
  52.388 +	Int_Numeral_Simprocs.simplify_meta_eq
  52.389 +	     [add_0, add_0_right,
  52.390 +	      mult_zero_left, mult_zero_right, mult_1, mult_1_right];
  52.391    end
  52.392  
  52.393  structure DivCancelNumeralFactor = CancelNumeralFactorFun
  52.394   (open CancelNumeralFactorCommon
  52.395    val prove_conv = Bin_Simprocs.prove_conv
  52.396    val mk_bal   = HOLogic.mk_binop "HOL.divide"
  52.397 -  val dest_bal = HOLogic.dest_bin "HOL.divide" Rat_Numeral_Simprocs.ratT
  52.398 +  val dest_bal = HOLogic.dest_bin "HOL.divide" Term.dummyT
  52.399    val cancel = mult_divide_cancel_left RS trans
  52.400    val neg_exchanges = false
  52.401  )
  52.402 @@ -407,8 +65,8 @@
  52.403   (open CancelNumeralFactorCommon
  52.404    val prove_conv = Bin_Simprocs.prove_conv
  52.405    val mk_bal   = HOLogic.mk_eq
  52.406 -  val dest_bal = HOLogic.dest_bin "op =" Rat_Numeral_Simprocs.ratT
  52.407 -  val cancel = mult_cancel_left RS trans
  52.408 +  val dest_bal = HOLogic.dest_bin "op =" Term.dummyT
  52.409 +  val cancel = field_mult_cancel_left RS trans
  52.410    val neg_exchanges = false
  52.411  )
  52.412  
  52.413 @@ -416,7 +74,7 @@
  52.414   (open CancelNumeralFactorCommon
  52.415    val prove_conv = Bin_Simprocs.prove_conv
  52.416    val mk_bal   = HOLogic.mk_binrel "op <"
  52.417 -  val dest_bal = HOLogic.dest_bin "op <" Rat_Numeral_Simprocs.ratT
  52.418 +  val dest_bal = HOLogic.dest_bin "op <" Term.dummyT
  52.419    val cancel = mult_less_cancel_left RS trans
  52.420    val neg_exchanges = true
  52.421  )
  52.422 @@ -425,36 +83,41 @@
  52.423   (open CancelNumeralFactorCommon
  52.424    val prove_conv = Bin_Simprocs.prove_conv
  52.425    val mk_bal   = HOLogic.mk_binrel "op <="
  52.426 -  val dest_bal = HOLogic.dest_bin "op <=" Rat_Numeral_Simprocs.ratT
  52.427 +  val dest_bal = HOLogic.dest_bin "op <=" Term.dummyT
  52.428    val cancel = mult_le_cancel_left RS trans
  52.429    val neg_exchanges = true
  52.430  )
  52.431  
  52.432 -val rat_cancel_numeral_factors_relations =
  52.433 -  map prep_simproc
  52.434 -   [("rateq_cancel_numeral_factor",
  52.435 -     ["(l::rat) * m = n", "(l::rat) = m * n"],
  52.436 +val field_cancel_numeral_factors_relations =
  52.437 +  map Bin_Simprocs.prep_simproc
  52.438 +   [("field_eq_cancel_numeral_factor",
  52.439 +     ["(l::'a::{field,number_ring}) * m = n",
  52.440 +      "(l::'a::{field,number_ring}) = m * n"],
  52.441       EqCancelNumeralFactor.proc),
  52.442 -    ("ratless_cancel_numeral_factor",
  52.443 -     ["(l::rat) * m < n", "(l::rat) < m * n"],
  52.444 +    ("field_less_cancel_numeral_factor",
  52.445 +     ["(l::'a::{ordered_field,number_ring}) * m < n",
  52.446 +      "(l::'a::{ordered_field,number_ring}) < m * n"],
  52.447       LessCancelNumeralFactor.proc),
  52.448 -    ("ratle_cancel_numeral_factor",
  52.449 -     ["(l::rat) * m <= n", "(l::rat) <= m * n"],
  52.450 +    ("field_le_cancel_numeral_factor",
  52.451 +     ["(l::'a::{ordered_field,number_ring}) * m <= n",
  52.452 +      "(l::'a::{ordered_field,number_ring}) <= m * n"],
  52.453       LeCancelNumeralFactor.proc)]
  52.454  
  52.455 -val rat_cancel_numeral_factors_divide = prep_simproc
  52.456 -        ("ratdiv_cancel_numeral_factor",
  52.457 -         ["((l::rat) * m) / n", "(l::rat) / (m * n)",
  52.458 -          "((number_of v)::rat) / (number_of w)"],
  52.459 +val field_cancel_numeral_factors_divide = 
  52.460 +    Bin_Simprocs.prep_simproc
  52.461 +        ("field_cancel_numeral_factor",
  52.462 +         ["((l::'a::{field,number_ring}) * m) / n",
  52.463 +          "(l::'a::{field,number_ring}) / (m * n)",
  52.464 +          "((number_of v)::'a::{field,number_ring}) / (number_of w)"],
  52.465           DivCancelNumeralFactor.proc)
  52.466  
  52.467 -val rat_cancel_numeral_factors =
  52.468 -    rat_cancel_numeral_factors_relations @
  52.469 -    [rat_cancel_numeral_factors_divide]
  52.470 +val field_cancel_numeral_factors =
  52.471 +    field_cancel_numeral_factors_relations @
  52.472 +    [field_cancel_numeral_factors_divide]
  52.473  
  52.474  end;
  52.475  
  52.476 -Addsimprocs rat_cancel_numeral_factors;
  52.477 +Addsimprocs field_cancel_numeral_factors;
  52.478  
  52.479  
  52.480  (*examples:
  52.481 @@ -497,8 +160,7 @@
  52.482  
  52.483  (** Declarations for ExtractCommonTerm **)
  52.484  
  52.485 -local
  52.486 -  open Rat_Numeral_Simprocs
  52.487 +local open Int_Numeral_Simprocs
  52.488  in
  52.489  
  52.490  structure CancelFactorCommon =
  52.491 @@ -512,32 +174,39 @@
  52.492    val norm_tac = ALLGOALS (simp_tac (HOL_ss addsimps mult_1s@mult_ac))
  52.493    end;
  52.494  
  52.495 +(*This version works for all fields, including unordered ones (complex).
  52.496 +  The version declared in int_factor_simprocs.ML is for integers.*)
  52.497  structure EqCancelFactor = ExtractCommonTermFun
  52.498   (open CancelFactorCommon
  52.499    val prove_conv = Bin_Simprocs.prove_conv
  52.500    val mk_bal   = HOLogic.mk_eq
  52.501 -  val dest_bal = HOLogic.dest_bin "op =" Rat_Numeral_Simprocs.ratT
  52.502 -  val simplify_meta_eq  = cancel_simplify_meta_eq mult_cancel_left
  52.503 +  val dest_bal = HOLogic.dest_bin "op =" Term.dummyT
  52.504 +  val simplify_meta_eq  = cancel_simplify_meta_eq field_mult_cancel_left
  52.505  );
  52.506  
  52.507  
  52.508 +(*This version works for fields, with the generic divides operator (/).
  52.509 +  The version declared in int_factor_simprocs.ML for integers with div.*)
  52.510  structure DivideCancelFactor = ExtractCommonTermFun
  52.511   (open CancelFactorCommon
  52.512    val prove_conv = Bin_Simprocs.prove_conv
  52.513    val mk_bal   = HOLogic.mk_binop "HOL.divide"
  52.514 -  val dest_bal = HOLogic.dest_bin "HOL.divide" Rat_Numeral_Simprocs.ratT
  52.515 +  val dest_bal = HOLogic.dest_bin "HOL.divide" Term.dummyT
  52.516    val simplify_meta_eq  = cancel_simplify_meta_eq mult_divide_cancel_eq_if
  52.517  );
  52.518  
  52.519 -val rat_cancel_factor =
  52.520 -  map prep_simproc
  52.521 -   [("rat_eq_cancel_factor", ["(l::rat) * m = n", "(l::rat) = m * n"], EqCancelFactor.proc),
  52.522 -    ("rat_divide_cancel_factor", ["((l::rat) * m) / n", "(l::rat) / (m * n)"],
  52.523 +val field_cancel_factor =
  52.524 +  map Bin_Simprocs.prep_simproc
  52.525 +   [("field_eq_cancel_factor",
  52.526 +     ["(l::'a::field) * m = n", "(l::'a::field) = m * n"], 
  52.527 +     EqCancelFactor.proc),
  52.528 +    ("field_divide_cancel_factor",
  52.529 +     ["((l::'a::field) * m) / n", "(l::'a::field) / (m * n)"],
  52.530       DivideCancelFactor.proc)];
  52.531  
  52.532  end;
  52.533  
  52.534 -Addsimprocs rat_cancel_factor;
  52.535 +Addsimprocs field_cancel_factor;
  52.536  
  52.537  
  52.538  (*examples:
  52.539 @@ -563,22 +232,12 @@
  52.540  
  52.541  
  52.542  
  52.543 -(****Instantiation of the generic linear arithmetic package****)
  52.544 +(****Instantiation of the generic linear arithmetic package for fields****)
  52.545  
  52.546  
  52.547  local
  52.548  
  52.549 -(* reduce contradictory <= to False *)
  52.550 -val add_rules = 
  52.551 -    [order_less_irrefl, rat_numeral_0_eq_0, rat_numeral_1_eq_1,
  52.552 -     rat_minus_1_eq_m1, 
  52.553 -     add_rat_number_of, minus_rat_number_of, diff_rat_number_of,
  52.554 -     mult_rat_number_of, eq_rat_number_of, less_rat_number_of];
  52.555 -
  52.556 -val simprocs = [Rat_Times_Assoc.conv, Rat_Numeral_Simprocs.combine_numerals,
  52.557 -                rat_cancel_numeral_factors_divide]@
  52.558 -               Rat_Numeral_Simprocs.cancel_numerals @
  52.559 -               Rat_Numeral_Simprocs.eval_numerals;
  52.560 +val simprocs = [field_cancel_numeral_factors_divide]
  52.561  
  52.562  val mono_ss = simpset() addsimps
  52.563                  [add_mono,add_strict_mono,add_less_le_mono,add_le_less_mono];
  52.564 @@ -600,15 +259,17 @@
  52.565    (rat_mult_left_mono,
  52.566     cvar(rat_mult_left_mono, hd(tl(prems_of rat_mult_left_mono))))]
  52.567  
  52.568 -val simps = [True_implies_equals,
  52.569 +val simps = [order_less_irrefl, True_implies_equals,
  52.570               inst "a" "(number_of ?v)" right_distrib,
  52.571 -             divide_1, times_divide_eq_right, times_divide_eq_left,
  52.572 +             divide_1, divide_zero_left,
  52.573 +             times_divide_eq_right, times_divide_eq_left,
  52.574  	     of_int_0, of_int_1, of_int_add, of_int_minus, of_int_diff,
  52.575 -	     of_int_mult, of_int_of_nat_eq, rat_number_of_def];
  52.576 +	     of_int_mult, of_int_of_nat_eq];
  52.577  
  52.578  in
  52.579  
  52.580 -val fast_rat_arith_simproc = Simplifier.simproc (Theory.sign_of(the_context()))
  52.581 +val fast_rat_arith_simproc = 
  52.582 + Simplifier.simproc (Theory.sign_of(the_context()))
  52.583    "fast_rat_arith" ["(m::rat) < n","(m::rat) <= n", "(m::rat) = n"]
  52.584    Fast_Arith.lin_arith_prover;
  52.585  
  52.586 @@ -618,21 +279,19 @@
  52.587  val int_inj_thms = [of_int_le_iff RS iffD2, of_int_less_iff RS iffD2,
  52.588                      of_int_eq_iff RS iffD2];
  52.589  
  52.590 +val ratT = Type("Rational.rat", []);
  52.591 +
  52.592  val rat_arith_setup =
  52.593   [Fast_Arith.map_data (fn {add_mono_thms, mult_mono_thms, inj_thms, lessD, simpset} =>
  52.594     {add_mono_thms = add_mono_thms @ add_mono_thms_ordered_field,
  52.595      mult_mono_thms = mult_mono_thms @ rat_mult_mono_thms,
  52.596      inj_thms = int_inj_thms @ inj_thms,
  52.597      lessD = lessD,  (*Can't change LA_Data_Ref.lessD: the rats are dense!*)
  52.598 -    simpset = simpset addsimps add_rules
  52.599 -                      addsimps simps
  52.600 +    simpset = simpset addsimps simps
  52.601                        addsimprocs simprocs}),
  52.602 -  arith_inj_const("IntDef.of_nat", HOLogic.natT --> Rat_Numeral_Simprocs.ratT),
  52.603 -  arith_inj_const("IntDef.of_int", HOLogic.intT --> Rat_Numeral_Simprocs.ratT),
  52.604 +  arith_inj_const("IntDef.of_nat", HOLogic.natT --> ratT),
  52.605 +  arith_inj_const("IntDef.of_int", HOLogic.intT --> ratT),
  52.606    arith_discrete ("Rational.rat",false),
  52.607    Simplifier.change_simpset_of (op addsimprocs) [fast_rat_arith_simproc]];
  52.608  
  52.609 -
  52.610  end;
  52.611 -
  52.612 -
    53.1 --- a/src/HOL/Real/real_arith.ML	Sat Feb 14 02:06:12 2004 +0100
    53.2 +++ b/src/HOL/Real/real_arith.ML	Sun Feb 15 10:46:37 2004 +0100
    53.3 @@ -12,598 +12,111 @@
    53.4  val real_mult_left_mono =
    53.5      read_instantiate_sg(sign_of (the_context())) [("a","?a::real")] mult_left_mono;
    53.6  
    53.7 -val real_numeral_0_eq_0 = thm "real_numeral_0_eq_0";
    53.8 -val real_numeral_1_eq_1 = thm "real_numeral_1_eq_1";
    53.9 -val real_number_of_def = thm "real_number_of_def";
   53.10 -val add_real_number_of = thm "add_real_number_of";
   53.11 -val minus_real_number_of = thm "minus_real_number_of";
   53.12 -val diff_real_number_of = thm "diff_real_number_of";
   53.13 -val mult_real_number_of = thm "mult_real_number_of";
   53.14 -val real_mult_2 = thm "real_mult_2";
   53.15 -val real_mult_2_right = thm "real_mult_2_right";
   53.16 -val eq_real_number_of = thm "eq_real_number_of";
   53.17 -val less_real_number_of = thm "less_real_number_of";
   53.18 -val real_minus_1_eq_m1 = thm "real_minus_1_eq_m1";
   53.19 -val real_mult_minus1 = thm "real_mult_minus1";
   53.20 -val real_mult_minus1_right = thm "real_mult_minus1_right";
   53.21 -val zero_less_real_of_nat_iff = thm "zero_less_real_of_nat_iff";
   53.22 -val zero_le_real_of_nat_iff = thm "zero_le_real_of_nat_iff";
   53.23 -val real_add_number_of_left = thm "real_add_number_of_left";
   53.24 -val real_mult_number_of_left = thm "real_mult_number_of_left";
   53.25 -val real_add_number_of_diff1 = thm "real_add_number_of_diff1";
   53.26 -val real_add_number_of_diff2 = thm "real_add_number_of_diff2";
   53.27 -val real_of_nat_number_of = thm "real_of_nat_number_of";
   53.28 -
   53.29 -(*Maps 0 to Numeral0 and 1 to Numeral1 and -(Numeral1) to -1*)
   53.30 -val real_numeral_ss =
   53.31 -    HOL_ss addsimps [real_numeral_0_eq_0 RS sym, real_numeral_1_eq_1 RS sym,
   53.32 -                     real_minus_1_eq_m1];
   53.33 -
   53.34 -fun rename_numerals th =
   53.35 -    asm_full_simplify real_numeral_ss (Thm.transfer (the_context ()) th);
   53.36 -
   53.37 -
   53.38 -structure Real_Numeral_Simprocs =
   53.39 -struct
   53.40 -
   53.41 -(*Maps 0 to Numeral0 and 1 to Numeral1 so that arithmetic in simprocs
   53.42 -  isn't complicated by the abstract 0 and 1.*)
   53.43 -val numeral_syms = [real_numeral_0_eq_0 RS sym, real_numeral_1_eq_1 RS sym];
   53.44 -
   53.45 -(*Utilities*)
   53.46 -
   53.47 -fun mk_numeral n = HOLogic.number_of_const HOLogic.realT $ HOLogic.mk_bin n;
   53.48 -
   53.49 -(*Decodes a binary real constant, or 0, 1*)
   53.50 -val dest_numeral = Int_Numeral_Simprocs.dest_numeral;
   53.51 -val find_first_numeral = Int_Numeral_Simprocs.find_first_numeral;
   53.52 -
   53.53 -val zero = mk_numeral 0;
   53.54 -val mk_plus = HOLogic.mk_binop "op +";
   53.55 -
   53.56 -val uminus_const = Const ("uminus", HOLogic.realT --> HOLogic.realT);
   53.57 -
   53.58 -(*Thus mk_sum[t] yields t+0; longer sums don't have a trailing zero*)
   53.59 -fun mk_sum []        = zero
   53.60 -  | mk_sum [t,u]     = mk_plus (t, u)
   53.61 -  | mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
   53.62 -
   53.63 -(*this version ALWAYS includes a trailing zero*)
   53.64 -fun long_mk_sum []        = zero
   53.65 -  | long_mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
   53.66 -
   53.67 -val dest_plus = HOLogic.dest_bin "op +" HOLogic.realT;
   53.68 -
   53.69 -(*decompose additions AND subtractions as a sum*)
   53.70 -fun dest_summing (pos, Const ("op +", _) $ t $ u, ts) =
   53.71 -        dest_summing (pos, t, dest_summing (pos, u, ts))
   53.72 -  | dest_summing (pos, Const ("op -", _) $ t $ u, ts) =
   53.73 -        dest_summing (pos, t, dest_summing (not pos, u, ts))
   53.74 -  | dest_summing (pos, t, ts) =
   53.75 -        if pos then t::ts else uminus_const$t :: ts;
   53.76 +val real_abs_def = thm "real_abs_def";
   53.77  
   53.78 -fun dest_sum t = dest_summing (true, t, []);
   53.79 -
   53.80 -val mk_diff = HOLogic.mk_binop "op -";
   53.81 -val dest_diff = HOLogic.dest_bin "op -" HOLogic.realT;
   53.82 -
   53.83 -val one = mk_numeral 1;
   53.84 -val mk_times = HOLogic.mk_binop "op *";
   53.85 -
   53.86 -fun mk_prod [] = one
   53.87 -  | mk_prod [t] = t
   53.88 -  | mk_prod (t :: ts) = if t = one then mk_prod ts
   53.89 -                        else mk_times (t, mk_prod ts);
   53.90 -
   53.91 -val dest_times = HOLogic.dest_bin "op *" HOLogic.realT;
   53.92 -
   53.93 -fun dest_prod t =
   53.94 -      let val (t,u) = dest_times t
   53.95 -      in  dest_prod t @ dest_prod u  end
   53.96 -      handle TERM _ => [t];
   53.97 -
   53.98 -(*DON'T do the obvious simplifications; that would create special cases*)
   53.99 -fun mk_coeff (k, ts) = mk_times (mk_numeral k, ts);
  53.100 -
  53.101 -(*Express t as a product of (possibly) a numeral with other sorted terms*)
  53.102 -fun dest_coeff sign (Const ("uminus", _) $ t) = dest_coeff (~sign) t
  53.103 -  | dest_coeff sign t =
  53.104 -    let val ts = sort Term.term_ord (dest_prod t)
  53.105 -        val (n, ts') = find_first_numeral [] ts
  53.106 -                          handle TERM _ => (1, ts)
  53.107 -    in (sign*n, mk_prod ts') end;
  53.108 -
  53.109 -(*Find first coefficient-term THAT MATCHES u*)
  53.110 -fun find_first_coeff past u [] = raise TERM("find_first_coeff", [])
  53.111 -  | find_first_coeff past u (t::terms) =
  53.112 -        let val (n,u') = dest_coeff 1 t
  53.113 -        in  if u aconv u' then (n, rev past @ terms)
  53.114 -                          else find_first_coeff (t::past) u terms
  53.115 -        end
  53.116 -        handle TERM _ => find_first_coeff (t::past) u terms;
  53.117 -
  53.118 -
  53.119 -(*Simplify Numeral0+n, n+Numeral0, Numeral1*n, n*Numeral1*)
  53.120 -val add_0s  = map rename_numerals [real_add_zero_left, real_add_zero_right];
  53.121 -val mult_1s = map rename_numerals [real_mult_1, real_mult_1_right] @
  53.122 -              [real_mult_minus1, real_mult_minus1_right];
  53.123 -
  53.124 -(*To perform binary arithmetic*)
  53.125 -val bin_simps =
  53.126 -    [real_numeral_0_eq_0 RS sym, real_numeral_1_eq_1 RS sym,
  53.127 -     add_real_number_of, real_add_number_of_left, minus_real_number_of,
  53.128 -     diff_real_number_of, mult_real_number_of, real_mult_number_of_left] @
  53.129 -    bin_arith_simps @ bin_rel_simps;
  53.130 -
  53.131 -(*Binary arithmetic BUT NOT ADDITION since it may collapse adjacent terms
  53.132 -  during re-arrangement*)
  53.133 -val non_add_bin_simps = 
  53.134 -    bin_simps \\ [real_add_number_of_left, add_real_number_of];
  53.135 -
  53.136 -(*To evaluate binary negations of coefficients*)
  53.137 -val real_minus_simps = NCons_simps @
  53.138 -                   [real_minus_1_eq_m1, minus_real_number_of,
  53.139 -                    bin_minus_1, bin_minus_0, bin_minus_Pls, bin_minus_Min,
  53.140 -                    bin_pred_1, bin_pred_0, bin_pred_Pls, bin_pred_Min];
  53.141 -
  53.142 -(*To let us treat subtraction as addition*)
  53.143 -val diff_simps = [real_diff_def, minus_add_distrib, minus_minus];
  53.144 -
  53.145 -(*to extract again any uncancelled minuses*)
  53.146 -val real_minus_from_mult_simps =
  53.147 -    [minus_minus, minus_mult_left RS sym, minus_mult_right RS sym];
  53.148 +val real_le_def = thm "real_le_def";
  53.149 +val real_diff_def = thm "real_diff_def";
  53.150 +val real_divide_def = thm "real_divide_def";
  53.151  
  53.152 -(*combine unary minus with numeric literals, however nested within a product*)
  53.153 -val real_mult_minus_simps =
  53.154 -    [mult_assoc, minus_mult_left, minus_mult_commute];
  53.155 -
  53.156 -(*Apply the given rewrite (if present) just once*)
  53.157 -fun trans_tac None      = all_tac
  53.158 -  | trans_tac (Some th) = ALLGOALS (rtac (th RS trans));
  53.159 -
  53.160 -(*Final simplification: cancel + and *  *)
  53.161 -val simplify_meta_eq =
  53.162 -    Int_Numeral_Simprocs.simplify_meta_eq
  53.163 -         [add_0, add_0_right,
  53.164 -          mult_zero_left, mult_zero_right, mult_1, mult_1_right];
  53.165 -
  53.166 -fun prep_simproc (name, pats, proc) =
  53.167 -  Simplifier.simproc (Theory.sign_of (the_context ())) name pats proc;
  53.168 -
  53.169 -structure CancelNumeralsCommon =
  53.170 -  struct
  53.171 -  val mk_sum            = mk_sum
  53.172 -  val dest_sum          = dest_sum
  53.173 -  val mk_coeff          = mk_coeff
  53.174 -  val dest_coeff        = dest_coeff 1
  53.175 -  val find_first_coeff  = find_first_coeff []
  53.176 -  val trans_tac         = trans_tac
  53.177 -  val norm_tac =
  53.178 -     ALLGOALS (simp_tac (HOL_ss addsimps add_0s@mult_1s@diff_simps@
  53.179 -                                         real_minus_simps@add_ac))
  53.180 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps non_add_bin_simps@real_mult_minus_simps))
  53.181 -     THEN ALLGOALS
  53.182 -              (simp_tac (HOL_ss addsimps real_minus_from_mult_simps@
  53.183 -                                         add_ac@mult_ac))
  53.184 -  val numeral_simp_tac  = ALLGOALS (simp_tac (HOL_ss addsimps add_0s@bin_simps))
  53.185 -  val simplify_meta_eq  = simplify_meta_eq
  53.186 -  end;
  53.187 -
  53.188 -
  53.189 -structure EqCancelNumerals = CancelNumeralsFun
  53.190 - (open CancelNumeralsCommon
  53.191 -  val prove_conv = Bin_Simprocs.prove_conv
  53.192 -  val mk_bal   = HOLogic.mk_eq
  53.193 -  val dest_bal = HOLogic.dest_bin "op =" HOLogic.realT
  53.194 -  val bal_add1 = eq_add_iff1 RS trans
  53.195 -  val bal_add2 = eq_add_iff2 RS trans
  53.196 -);
  53.197 -
  53.198 -structure LessCancelNumerals = CancelNumeralsFun
  53.199 - (open CancelNumeralsCommon
  53.200 -  val prove_conv = Bin_Simprocs.prove_conv
  53.201 -  val mk_bal   = HOLogic.mk_binrel "op <"
  53.202 -  val dest_bal = HOLogic.dest_bin "op <" HOLogic.realT
  53.203 -  val bal_add1 = less_add_iff1 RS trans
  53.204 -  val bal_add2 = less_add_iff2 RS trans
  53.205 -);
  53.206 -
  53.207 -structure LeCancelNumerals = CancelNumeralsFun
  53.208 - (open CancelNumeralsCommon
  53.209 -  val prove_conv = Bin_Simprocs.prove_conv
  53.210 -  val mk_bal   = HOLogic.mk_binrel "op <="
  53.211 -  val dest_bal = HOLogic.dest_bin "op <=" HOLogic.realT
  53.212 -  val bal_add1 = le_add_iff1 RS trans
  53.213 -  val bal_add2 = le_add_iff2 RS trans
  53.214 -);
  53.215 -
  53.216 -val cancel_numerals =
  53.217 -  map prep_simproc
  53.218 -   [("realeq_cancel_numerals",
  53.219 -     ["(l::real) + m = n", "(l::real) = m + n",
  53.220 -      "(l::real) - m = n", "(l::real) = m - n",
  53.221 -      "(l::real) * m = n", "(l::real) = m * n"],
  53.222 -     EqCancelNumerals.proc),
  53.223 -    ("realless_cancel_numerals",
  53.224 -     ["(l::real) + m < n", "(l::real) < m + n",
  53.225 -      "(l::real) - m < n", "(l::real) < m - n",
  53.226 -      "(l::real) * m < n", "(l::real) < m * n"],
  53.227 -     LessCancelNumerals.proc),
  53.228 -    ("realle_cancel_numerals",
  53.229 -     ["(l::real) + m <= n", "(l::real) <= m + n",
  53.230 -      "(l::real) - m <= n", "(l::real) <= m - n",
  53.231 -      "(l::real) * m <= n", "(l::real) <= m * n"],
  53.232 -     LeCancelNumerals.proc)];
  53.233 -
  53.234 -
  53.235 -structure CombineNumeralsData =
  53.236 -  struct
  53.237 -  val add               = op + : int*int -> int
  53.238 -  val mk_sum            = long_mk_sum    (*to work for e.g. 2*x + 3*x *)
  53.239 -  val dest_sum          = dest_sum
  53.240 -  val mk_coeff          = mk_coeff
  53.241 -  val dest_coeff        = dest_coeff 1
  53.242 -  val left_distrib      = combine_common_factor RS trans
  53.243 -  val prove_conv        = Bin_Simprocs.prove_conv_nohyps
  53.244 -  val trans_tac         = trans_tac
  53.245 -  val norm_tac =
  53.246 -     ALLGOALS (simp_tac (HOL_ss addsimps numeral_syms@add_0s@mult_1s@
  53.247 -                                   diff_simps@real_minus_simps@add_ac))
  53.248 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps non_add_bin_simps@real_mult_minus_simps))
  53.249 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps real_minus_from_mult_simps@
  53.250 -                                              add_ac@mult_ac))
  53.251 -  val numeral_simp_tac  = ALLGOALS
  53.252 -                    (simp_tac (HOL_ss addsimps add_0s@bin_simps))
  53.253 -  val simplify_meta_eq  =
  53.254 -        Int_Numeral_Simprocs.simplify_meta_eq (add_0s@mult_1s)
  53.255 -  end;
  53.256 -
  53.257 -structure CombineNumerals = CombineNumeralsFun(CombineNumeralsData);
  53.258 -
  53.259 -val combine_numerals =
  53.260 -  prep_simproc ("real_combine_numerals", ["(i::real) + j", "(i::real) - j"], CombineNumerals.proc);
  53.261 -
  53.262 -
  53.263 -(** Declarations for ExtractCommonTerm **)
  53.264 -
  53.265 -(*this version ALWAYS includes a trailing one*)
  53.266 -fun long_mk_prod []        = one
  53.267 -  | long_mk_prod (t :: ts) = mk_times (t, mk_prod ts);
  53.268 -
  53.269 -(*Find first term that matches u*)
  53.270 -fun find_first past u []         = raise TERM("find_first", [])
  53.271 -  | find_first past u (t::terms) =
  53.272 -        if u aconv t then (rev past @ terms)
  53.273 -        else find_first (t::past) u terms
  53.274 -        handle TERM _ => find_first (t::past) u terms;
  53.275 -
  53.276 -(*Final simplification: cancel + and *  *)
  53.277 -fun cancel_simplify_meta_eq cancel_th th =
  53.278 -    Int_Numeral_Simprocs.simplify_meta_eq
  53.279 -        [real_mult_1, real_mult_1_right]
  53.280 -        (([th, cancel_th]) MRS trans);
  53.281 -
  53.282 -(*** Making constant folding work for 0 and 1 too ***)
  53.283 -
  53.284 -structure RealAbstractNumeralsData =
  53.285 -  struct
  53.286 -  val dest_eq         = HOLogic.dest_eq o HOLogic.dest_Trueprop o concl_of
  53.287 -  val is_numeral      = Bin_Simprocs.is_numeral
  53.288 -  val numeral_0_eq_0  = real_numeral_0_eq_0
  53.289 -  val numeral_1_eq_1  = real_numeral_1_eq_1
  53.290 -  val prove_conv      = Bin_Simprocs.prove_conv_nohyps_novars
  53.291 -  fun norm_tac simps  = ALLGOALS (simp_tac (HOL_ss addsimps simps))
  53.292 -  val simplify_meta_eq = Bin_Simprocs.simplify_meta_eq
  53.293 -  end
  53.294 -
  53.295 -structure RealAbstractNumerals = AbstractNumeralsFun (RealAbstractNumeralsData)
  53.296 +val realrel_iff = thm"realrel_iff";
  53.297 +val realrel_refl = thm"realrel_refl";
  53.298 +val equiv_realrel = thm"equiv_realrel";
  53.299 +val equiv_realrel_iff = thm"equiv_realrel_iff";
  53.300 +val realrel_in_real = thm"realrel_in_real";
  53.301 +val inj_on_Abs_REAL = thm"inj_on_Abs_REAL";
  53.302 +val eq_realrelD = thm"eq_realrelD";
  53.303 +val inj_Rep_REAL = thm"inj_Rep_REAL";
  53.304 +val inj_real_of_preal = thm"inj_real_of_preal";
  53.305 +val eq_Abs_REAL = thm"eq_Abs_REAL";
  53.306 +val real_minus_congruent = thm"real_minus_congruent";
  53.307 +val real_minus = thm"real_minus";
  53.308 +val real_add = thm"real_add";
  53.309 +val real_add_commute = thm"real_add_commute";
  53.310 +val real_add_assoc = thm"real_add_assoc";
  53.311 +val real_add_zero_left = thm"real_add_zero_left";
  53.312 +val real_add_zero_right = thm"real_add_zero_right";
  53.313  
  53.314 -(*For addition, we already have rules for the operand 0.
  53.315 -  Multiplication is omitted because there are already special rules for
  53.316 -  both 0 and 1 as operands.  Unary minus is trivial, just have - 1 = -1.
  53.317 -  For the others, having three patterns is a compromise between just having
  53.318 -  one (many spurious calls) and having nine (just too many!) *)
  53.319 -val eval_numerals =
  53.320 -  map prep_simproc
  53.321 -   [("real_add_eval_numerals",
  53.322 -     ["(m::real) + 1", "(m::real) + number_of v"],
  53.323 -     RealAbstractNumerals.proc add_real_number_of),
  53.324 -    ("real_diff_eval_numerals",
  53.325 -     ["(m::real) - 1", "(m::real) - number_of v"],
  53.326 -     RealAbstractNumerals.proc diff_real_number_of),
  53.327 -    ("real_eq_eval_numerals",
  53.328 -     ["(m::real) = 0", "(m::real) = 1", "(m::real) = number_of v"],
  53.329 -     RealAbstractNumerals.proc eq_real_number_of),
  53.330 -    ("real_less_eval_numerals",
  53.331 -     ["(m::real) < 0", "(m::real) < 1", "(m::real) < number_of v"],
  53.332 -     RealAbstractNumerals.proc less_real_number_of),
  53.333 -    ("real_le_eval_numerals",
  53.334 -     ["(m::real) <= 0", "(m::real) <= 1", "(m::real) <= number_of v"],
  53.335 -     RealAbstractNumerals.proc le_number_of_eq_not_less)]
  53.336 -
  53.337 -end;
  53.338 -
  53.339 -
  53.340 -Addsimprocs Real_Numeral_Simprocs.eval_numerals;
  53.341 -Addsimprocs Real_Numeral_Simprocs.cancel_numerals;
  53.342 -Addsimprocs [Real_Numeral_Simprocs.combine_numerals];
  53.343 -
  53.344 -(*examples:
  53.345 -print_depth 22;
  53.346 -set timing;
  53.347 -set trace_simp;
  53.348 -fun test s = (Goal s; by (Simp_tac 1));
  53.349 -
  53.350 -test "l + 2 + 2 + 2 + (l + 2) + (oo + 2) = (uu::real)";
  53.351 -
  53.352 -test "2*u = (u::real)";
  53.353 -test "(i + j + 12 + (k::real)) - 15 = y";
  53.354 -test "(i + j + 12 + (k::real)) - 5 = y";
  53.355 -
  53.356 -test "y - b < (b::real)";
  53.357 -test "y - (3*b + c) < (b::real) - 2*c";
  53.358 -
  53.359 -test "(2*x - (u*v) + y) - v*3*u = (w::real)";
  53.360 -test "(2*x*u*v + (u*v)*4 + y) - v*u*4 = (w::real)";
  53.361 -test "(2*x*u*v + (u*v)*4 + y) - v*u = (w::real)";
  53.362 -test "u*v - (x*u*v + (u*v)*4 + y) = (w::real)";
  53.363 -
  53.364 -test "(i + j + 12 + (k::real)) = u + 15 + y";
  53.365 -test "(i + j*2 + 12 + (k::real)) = j + 5 + y";
  53.366 -
  53.367 -test "2*y + 3*z + 6*w + 2*y + 3*z + 2*u = 2*y' + 3*z' + 6*w' + 2*y' + 3*z' + u + (vv::real)";
  53.368 -
  53.369 -test "a + -(b+c) + b = (d::real)";
  53.370 -test "a + -(b+c) - b = (d::real)";
  53.371 -
  53.372 -(*negative numerals*)
  53.373 -test "(i + j + -2 + (k::real)) - (u + 5 + y) = zz";
  53.374 -test "(i + j + -3 + (k::real)) < u + 5 + y";
  53.375 -test "(i + j + 3 + (k::real)) < u + -6 + y";
  53.376 -test "(i + j + -12 + (k::real)) - 15 = y";
  53.377 -test "(i + j + 12 + (k::real)) - -15 = y";
  53.378 -test "(i + j + -12 + (k::real)) - -15 = y";
  53.379 -*)
  53.380 -
  53.381 -
  53.382 -(** Constant folding for real plus and times **)
  53.383 -
  53.384 -(*We do not need
  53.385 -    structure Real_Plus_Assoc = Assoc_Fold (Real_Plus_Assoc_Data);
  53.386 -  because combine_numerals does the same thing*)
  53.387 -
  53.388 -structure Real_Times_Assoc_Data : ASSOC_FOLD_DATA =
  53.389 -struct
  53.390 -  val ss                = HOL_ss
  53.391 -  val eq_reflection     = eq_reflection
  53.392 -  val sg_ref    = Sign.self_ref (Theory.sign_of (the_context ()))
  53.393 -  val T      = HOLogic.realT
  53.394 -  val plus   = Const ("op *", [HOLogic.realT,HOLogic.realT] ---> HOLogic.realT)
  53.395 -  val add_ac = mult_ac
  53.396 -end;
  53.397 -
  53.398 -structure Real_Times_Assoc = Assoc_Fold (Real_Times_Assoc_Data);
  53.399 -
  53.400 -Addsimprocs [Real_Times_Assoc.conv];
  53.401 -
  53.402 -
  53.403 -(****Common factor cancellation****)
  53.404 -
  53.405 -(*To quote from Provers/Arith/cancel_numeral_factor.ML:
  53.406 -
  53.407 -This simproc Cancels common coefficients in balanced expressions:
  53.408 -
  53.409 -     u*#m ~~ u'*#m'  ==  #n*u ~~ #n'*u'
  53.410 -
  53.411 -where ~~ is an appropriate balancing operation (e.g. =, <=, <, div, /)
  53.412 -and d = gcd(m,m') and n=m/d and n'=m'/d.
  53.413 -*)
  53.414 -
  53.415 -local
  53.416 -  open Real_Numeral_Simprocs
  53.417 -in
  53.418 -
  53.419 -val rel_real_number_of = [eq_real_number_of, less_real_number_of,
  53.420 -                          le_number_of_eq_not_less]
  53.421 -
  53.422 -structure CancelNumeralFactorCommon =
  53.423 -  struct
  53.424 -  val mk_coeff          = mk_coeff
  53.425 -  val dest_coeff        = dest_coeff 1
  53.426 -  val trans_tac         = trans_tac
  53.427 -  val norm_tac =
  53.428 -     ALLGOALS (simp_tac (HOL_ss addsimps real_minus_from_mult_simps @ mult_1s))
  53.429 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps bin_simps@real_mult_minus_simps))
  53.430 -     THEN ALLGOALS (simp_tac (HOL_ss addsimps mult_ac))
  53.431 -  val numeral_simp_tac  =
  53.432 -         ALLGOALS (simp_tac (HOL_ss addsimps rel_real_number_of@bin_simps))
  53.433 -  val simplify_meta_eq  = simplify_meta_eq
  53.434 -  end
  53.435 -
  53.436 -structure DivCancelNumeralFactor = CancelNumeralFactorFun
  53.437 - (open CancelNumeralFactorCommon
  53.438 -  val prove_conv = Bin_Simprocs.prove_conv
  53.439 -  val mk_bal   = HOLogic.mk_binop "HOL.divide"
  53.440 -  val dest_bal = HOLogic.dest_bin "HOL.divide" HOLogic.realT
  53.441 -  val cancel = mult_divide_cancel_left RS trans
  53.442 -  val neg_exchanges = false
  53.443 -)
  53.444 -
  53.445 -structure EqCancelNumeralFactor = CancelNumeralFactorFun
  53.446 - (open CancelNumeralFactorCommon
  53.447 -  val prove_conv = Bin_Simprocs.prove_conv
  53.448 -  val mk_bal   = HOLogic.mk_eq
  53.449 -  val dest_bal = HOLogic.dest_bin "op =" HOLogic.realT
  53.450 -  val cancel = mult_cancel_left RS trans
  53.451 -  val neg_exchanges = false
  53.452 -)
  53.453 +val real_mult = thm"real_mult";
  53.454 +val real_mult_commute = thm"real_mult_commute";
  53.455 +val real_mult_assoc = thm"real_mult_assoc";
  53.456 +val real_mult_1 = thm"real_mult_1";
  53.457 +val real_mult_1_right = thm"real_mult_1_right";
  53.458 +val preal_le_linear = thm"preal_le_linear";
  53.459 +val real_mult_inverse_left = thm"real_mult_inverse_left";
  53.460 +val real_not_refl2 = thm"real_not_refl2";
  53.461 +val real_of_preal_add = thm"real_of_preal_add";
  53.462 +val real_of_preal_mult = thm"real_of_preal_mult";
  53.463 +val real_of_preal_trichotomy = thm"real_of_preal_trichotomy";
  53.464 +val real_of_preal_minus_less_zero = thm"real_of_preal_minus_less_zero";
  53.465 +val real_of_preal_not_minus_gt_zero = thm"real_of_preal_not_minus_gt_zero";
  53.466 +val real_of_preal_zero_less = thm"real_of_preal_zero_less";
  53.467 +val real_le_imp_less_or_eq = thm"real_le_imp_less_or_eq";
  53.468 +val real_le_refl = thm"real_le_refl";
  53.469 +val real_le_linear = thm"real_le_linear";
  53.470 +val real_le_trans = thm"real_le_trans";
  53.471 +val real_le_anti_sym = thm"real_le_anti_sym";
  53.472 +val real_less_le = thm"real_less_le";
  53.473 +val real_less_sum_gt_zero = thm"real_less_sum_gt_zero";
  53.474 +val real_gt_zero_preal_Ex = thm "real_gt_zero_preal_Ex";
  53.475 +val real_gt_preal_preal_Ex = thm "real_gt_preal_preal_Ex";
  53.476 +val real_ge_preal_preal_Ex = thm "real_ge_preal_preal_Ex";
  53.477 +val real_less_all_preal = thm "real_less_all_preal";
  53.478 +val real_less_all_real2 = thm "real_less_all_real2";
  53.479 +val real_of_preal_le_iff = thm "real_of_preal_le_iff";
  53.480 +val real_mult_order = thm "real_mult_order";
  53.481 +val real_zero_less_one = thm "real_zero_less_one";
  53.482 +val real_add_less_le_mono = thm "real_add_less_le_mono";
  53.483 +val real_add_le_less_mono = thm "real_add_le_less_mono";
  53.484 +val real_add_order = thm "real_add_order";
  53.485 +val real_le_add_order = thm "real_le_add_order";
  53.486 +val real_le_square = thm "real_le_square";
  53.487 +val real_mult_less_mono2 = thm "real_mult_less_mono2";
  53.488  
  53.489 -structure LessCancelNumeralFactor = CancelNumeralFactorFun
  53.490 - (open CancelNumeralFactorCommon
  53.491 -  val prove_conv = Bin_Simprocs.prove_conv
  53.492 -  val mk_bal   = HOLogic.mk_binrel "op <"
  53.493 -  val dest_bal = HOLogic.dest_bin "op <" HOLogic.realT
  53.494 -  val cancel = mult_less_cancel_left RS trans
  53.495 -  val neg_exchanges = true
  53.496 -)
  53.497 -
  53.498 -structure LeCancelNumeralFactor = CancelNumeralFactorFun
  53.499 - (open CancelNumeralFactorCommon
  53.500 -  val prove_conv = Bin_Simprocs.prove_conv
  53.501 -  val mk_bal   = HOLogic.mk_binrel "op <="
  53.502 -  val dest_bal = HOLogic.dest_bin "op <=" HOLogic.realT
  53.503 -  val cancel = mult_le_cancel_left RS trans
  53.504 -  val neg_exchanges = true
  53.505 -)
  53.506 -
  53.507 -val real_cancel_numeral_factors_relations =
  53.508 -  map prep_simproc
  53.509 -   [("realeq_cancel_numeral_factor",
  53.510 -     ["(l::real) * m = n", "(l::real) = m * n"],
  53.511 -     EqCancelNumeralFactor.proc),
  53.512 -    ("realless_cancel_numeral_factor",
  53.513 -     ["(l::real) * m < n", "(l::real) < m * n"],
  53.514 -     LessCancelNumeralFactor.proc),
  53.515 -    ("realle_cancel_numeral_factor",
  53.516 -     ["(l::real) * m <= n", "(l::real) <= m * n"],
  53.517 -     LeCancelNumeralFactor.proc)]
  53.518 -
  53.519 -val real_cancel_numeral_factors_divide = prep_simproc
  53.520 -        ("realdiv_cancel_numeral_factor",
  53.521 -         ["((l::real) * m) / n", "(l::real) / (m * n)",
  53.522 -          "((number_of v)::real) / (number_of w)"],
  53.523 -         DivCancelNumeralFactor.proc)
  53.524 +val real_mult_less_iff1 = thm "real_mult_less_iff1";
  53.525 +val real_mult_le_cancel_iff1 = thm "real_mult_le_cancel_iff1";
  53.526 +val real_mult_le_cancel_iff2 = thm "real_mult_le_cancel_iff2";
  53.527 +val real_mult_less_mono = thm "real_mult_less_mono";
  53.528 +val real_mult_less_mono' = thm "real_mult_less_mono'";
  53.529 +val real_sum_squares_cancel = thm "real_sum_squares_cancel";
  53.530 +val real_sum_squares_cancel2 = thm "real_sum_squares_cancel2";
  53.531  
  53.532 -val real_cancel_numeral_factors =
  53.533 -    real_cancel_numeral_factors_relations @
  53.534 -    [real_cancel_numeral_factors_divide]
  53.535 -
  53.536 -end;
  53.537 -
  53.538 -Addsimprocs real_cancel_numeral_factors;
  53.539 -
  53.540 -
  53.541 -(*examples:
  53.542 -print_depth 22;
  53.543 -set timing;
  53.544 -set trace_simp;
  53.545 -fun test s = (Goal s; by (Simp_tac 1));
  53.546 -
  53.547 -test "0 <= (y::real) * -2";
  53.548 -test "9*x = 12 * (y::real)";
  53.549 -test "(9*x) / (12 * (y::real)) = z";
  53.550 -test "9*x < 12 * (y::real)";
  53.551 -test "9*x <= 12 * (y::real)";
  53.552 -
  53.553 -test "-99*x = 132 * (y::real)";
  53.554 -test "(-99*x) / (132 * (y::real)) = z";
  53.555 -test "-99*x < 132 * (y::real)";
  53.556 -test "-99*x <= 132 * (y::real)";
  53.557 -
  53.558 -test "999*x = -396 * (y::real)";
  53.559 -test "(999*x) / (-396 * (y::real)) = z";
  53.560 -test "999*x < -396 * (y::real)";
  53.561 -test "999*x <= -396 * (y::real)";
  53.562 -
  53.563 -test  "(- ((2::real) * x) <= 2 * y)";
  53.564 -test "-99*x = -81 * (y::real)";
  53.565 -test "(-99*x) / (-81 * (y::real)) = z";
  53.566 -test "-99*x <= -81 * (y::real)";
  53.567 -test "-99*x < -81 * (y::real)";
  53.568 +val real_mult_left_cancel = thm"real_mult_left_cancel";
  53.569 +val real_mult_right_cancel = thm"real_mult_right_cancel";
  53.570 +val real_inverse_unique = thm "real_inverse_unique";
  53.571 +val real_inverse_gt_one = thm "real_inverse_gt_one";
  53.572  
  53.573 -test "-2 * x = -1 * (y::real)";
  53.574 -test "-2 * x = -(y::real)";
  53.575 -test "(-2 * x) / (-1 * (y::real)) = z";
  53.576 -test "-2 * x < -(y::real)";
  53.577 -test "-2 * x <= -1 * (y::real)";
  53.578 -test "-x < -23 * (y::real)";
  53.579 -test "-x <= -23 * (y::real)";
  53.580 -*)
  53.581 -
  53.582 -
  53.583 -(** Declarations for ExtractCommonTerm **)
  53.584 -
  53.585 -local
  53.586 -  open Real_Numeral_Simprocs
  53.587 -in
  53.588 -
  53.589 -structure CancelFactorCommon =
  53.590 -  struct
  53.591 -  val mk_sum            = long_mk_prod
  53.592 -  val dest_sum          = dest_prod
  53.593 -  val mk_coeff          = mk_coeff
  53.594 -  val dest_coeff        = dest_coeff
  53.595 -  val find_first        = find_first []
  53.596 -  val trans_tac         = trans_tac
  53.597 -  val norm_tac = ALLGOALS (simp_tac (HOL_ss addsimps mult_1s@mult_ac))
  53.598 -  end;
  53.599 -
  53.600 -structure EqCancelFactor = ExtractCommonTermFun
  53.601 - (open CancelFactorCommon
  53.602 -  val prove_conv = Bin_Simprocs.prove_conv
  53.603 -  val mk_bal   = HOLogic.mk_eq
  53.604 -  val dest_bal = HOLogic.dest_bin "op =" HOLogic.realT
  53.605 -  val simplify_meta_eq  = cancel_simplify_meta_eq mult_cancel_left
  53.606 -);
  53.607 -
  53.608 -
  53.609 -structure DivideCancelFactor = ExtractCommonTermFun
  53.610 - (open CancelFactorCommon
  53.611 -  val prove_conv = Bin_Simprocs.prove_conv
  53.612 -  val mk_bal   = HOLogic.mk_binop "HOL.divide"
  53.613 -  val dest_bal = HOLogic.dest_bin "HOL.divide" HOLogic.realT
  53.614 -  val simplify_meta_eq  = cancel_simplify_meta_eq mult_divide_cancel_eq_if
  53.615 -);
  53.616 -
  53.617 -val real_cancel_factor =
  53.618 -  map prep_simproc
  53.619 -   [("real_eq_cancel_factor", ["(l::real) * m = n", "(l::real) = m * n"], EqCancelFactor.proc),
  53.620 -    ("real_divide_cancel_factor", ["((l::real) * m) / n", "(l::real) / (m * n)"],
  53.621 -     DivideCancelFactor.proc)];
  53.622 -
  53.623 -end;
  53.624 -
  53.625 -Addsimprocs real_cancel_factor;
  53.626 -
  53.627 -
  53.628 -(*examples:
  53.629 -print_depth 22;
  53.630 -set timing;
  53.631 -set trace_simp;
  53.632 -fun test s = (Goal s; by (Asm_simp_tac 1));
  53.633 -
  53.634 -test "x*k = k*(y::real)";
  53.635 -test "k = k*(y::real)";
  53.636 -test "a*(b*c) = (b::real)";
  53.637 -test "a*(b*c) = d*(b::real)*(x*a)";
  53.638 -
  53.639 -
  53.640 -test "(x*k) / (k*(y::real)) = (uu::real)";
  53.641 -test "(k) / (k*(y::real)) = (uu::real)";
  53.642 -test "(a*(b*c)) / ((b::real)) = (uu::real)";
  53.643 -test "(a*(b*c)) / (d*(b::real)*(x*a)) = (uu::real)";
  53.644 -
  53.645 -(*FIXME: what do we do about this?*)
  53.646 -test "a*(b*c)/(y*z) = d*(b::real)*(x*a)/z";
  53.647 -*)
  53.648 -
  53.649 +val real_of_int_zero = thm"real_of_int_zero";
  53.650 +val real_of_one = thm"real_of_one";
  53.651 +val real_of_int_add = thm"real_of_int_add";
  53.652 +val real_of_int_minus = thm"real_of_int_minus";
  53.653 +val real_of_int_diff = thm"real_of_int_diff";
  53.654 +val real_of_int_mult = thm"real_of_int_mult";
  53.655 +val real_of_int_real_of_nat = thm"real_of_int_real_of_nat";
  53.656 +val real_of_int_inject = thm"real_of_int_inject";
  53.657 +val real_of_int_less_iff = thm"real_of_int_less_iff";
  53.658 +val real_of_int_le_iff = thm"real_of_int_le_iff";
  53.659 +val real_of_nat_zero = thm "real_of_nat_zero";
  53.660 +val real_of_nat_one = thm "real_of_nat_one";
  53.661 +val real_of_nat_add = thm "real_of_nat_add";
  53.662 +val real_of_nat_Suc = thm "real_of_nat_Suc";
  53.663 +val real_of_nat_less_iff = thm "real_of_nat_less_iff";
  53.664 +val real_of_nat_le_iff = thm "real_of_nat_le_iff";
  53.665 +val real_of_nat_ge_zero = thm "real_of_nat_ge_zero";
  53.666 +val real_of_nat_Suc_gt_zero = thm "real_of_nat_Suc_gt_zero";
  53.667 +val real_of_nat_mult = thm "real_of_nat_mult";
  53.668 +val real_of_nat_inject = thm "real_of_nat_inject";
  53.669 +val real_of_nat_diff = thm "real_of_nat_diff";
  53.670 +val real_of_nat_zero_iff = thm "real_of_nat_zero_iff";
  53.671 +val real_of_nat_gt_zero_cancel_iff = thm "real_of_nat_gt_zero_cancel_iff";
  53.672 +val real_of_nat_le_zero_cancel_iff = thm "real_of_nat_le_zero_cancel_iff";
  53.673 +val not_real_of_nat_less_zero = thm "not_real_of_nat_less_zero";
  53.674 +val real_of_nat_ge_zero_cancel_iff = thm "real_of_nat_ge_zero_cancel_iff";
  53.675  
  53.676  
  53.677  (****Instantiation of the generic linear arithmetic package****)
  53.678  
  53.679  local
  53.680  
  53.681 -(* reduce contradictory <= to False *)
  53.682 -val add_rules = 
  53.683 -    [real_numeral_0_eq_0, real_numeral_1_eq_1,
  53.684 -     add_real_number_of, minus_real_number_of, diff_real_number_of,
  53.685 -     mult_real_number_of, eq_real_number_of, less_real_number_of];
  53.686 -
  53.687 -val simprocs = [Real_Times_Assoc.conv, Real_Numeral_Simprocs.combine_numerals,
  53.688 -                real_cancel_numeral_factors_divide]@
  53.689 -               Real_Numeral_Simprocs.cancel_numerals @
  53.690 -               Real_Numeral_Simprocs.eval_numerals;
  53.691 -
  53.692  fun cvar(th,_ $ (_ $ _ $ var)) = cterm_of (#sign(rep_thm th)) var;
  53.693  
  53.694  val real_mult_mono_thms =
  53.695 @@ -615,7 +128,7 @@
  53.696  val simps = [real_of_nat_zero, real_of_nat_Suc, real_of_nat_add, 
  53.697         real_of_nat_mult, real_of_int_zero, real_of_one, real_of_int_add RS sym,
  53.698         real_of_int_minus RS sym, real_of_int_diff RS sym,
  53.699 -       real_of_int_mult RS sym, symmetric real_number_of_def];
  53.700 +       real_of_int_mult RS sym];
  53.701  
  53.702  val int_inj_thms = [real_of_int_le_iff RS iffD2, real_of_int_less_iff RS iffD2,
  53.703                      real_of_int_inject RS iffD2];
  53.704 @@ -625,7 +138,8 @@
  53.705  
  53.706  in
  53.707  
  53.708 -val fast_real_arith_simproc = Simplifier.simproc (Theory.sign_of (the_context ()))
  53.709 +val fast_real_arith_simproc =
  53.710 + Simplifier.simproc (Theory.sign_of (the_context ()))
  53.711    "fast_real_arith" ["(m::real) < n","(m::real) <= n", "(m::real) = n"]
  53.712    Fast_Arith.lin_arith_prover;
  53.713  
  53.714 @@ -635,9 +149,7 @@
  53.715      mult_mono_thms = mult_mono_thms @ real_mult_mono_thms,
  53.716      inj_thms = int_inj_thms @ nat_inj_thms @ inj_thms,
  53.717      lessD = lessD,  (*Can't change LA_Data_Ref.lessD: the reals are dense!*)
  53.718 -    simpset = simpset addsimps add_rules
  53.719 -                      addsimps simps
  53.720 -                      addsimprocs simprocs}),
  53.721 +    simpset = simpset addsimps simps}),
  53.722    arith_inj_const ("RealDef.real", HOLogic.natT --> HOLogic.realT),
  53.723    arith_inj_const ("RealDef.real", HOLogic.intT --> HOLogic.realT),
  53.724    arith_discrete ("RealDef.real",false),
  53.725 @@ -645,7 +157,6 @@
  53.726  
  53.727  (* some thms for injection nat => real:
  53.728  real_of_nat_zero
  53.729 -?zero_eq_numeral_0
  53.730  real_of_nat_add
  53.731  *)
  53.732  
    54.1 --- a/src/HOL/Ring_and_Field.thy	Sat Feb 14 02:06:12 2004 +0100
    54.2 +++ b/src/HOL/Ring_and_Field.thy	Sun Feb 15 10:46:37 2004 +0100
    54.3 @@ -36,7 +36,7 @@
    54.4    diff_minus: "a - b = a + (-b)"
    54.5  
    54.6  axclass ordered_semiring \<subseteq> semiring, linorder
    54.7 -  zero_less_one: "0 < 1" --{*This axiom too is needed for semirings only.*}
    54.8 +  zero_less_one [simp]: "0 < 1" --{*This too is needed for semirings only.*}
    54.9    add_left_mono: "a \<le> b ==> c + a \<le> c + b"
   54.10    mult_strict_left_mono: "a < b ==> 0 < c ==> c * a < c * b"
   54.11  
   54.12 @@ -301,6 +301,9 @@
   54.13        "a + c \<le> b + c ==> a \<le> (b::'a::ordered_semiring)"
   54.14  by simp
   54.15  
   54.16 +lemma add_increasing: "[|0\<le>a; b\<le>c|] ==> b \<le> a + (c::'a::ordered_semiring)"
   54.17 +by (insert add_mono [of 0 a b c], simp)
   54.18 +
   54.19  
   54.20  subsection {* Ordering Rules for Unary Minus *}
   54.21  
   54.22 @@ -571,9 +574,19 @@
   54.23  lemma zero_le_square: "(0::'a::ordered_ring) \<le> a*a"
   54.24  by (simp add: zero_le_mult_iff linorder_linear) 
   54.25