src/HOL/Real/RealBin.ML
author wenzelm
Sat, 01 Dec 2001 18:52:32 +0100
changeset 12338 de0f4a63baa5
parent 12018 ec054019c910
child 12483 0a01efff43e9
permissions -rw-r--r--
renamed class "term" to "type" (actually "HOL.type");
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
9433
ac20534ce4d1 avoid referencing thy value;
wenzelm
parents: 9108
diff changeset
     1
(*  Title:      HOL/Real/RealBin.ML
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
     2
    ID:         $Id$
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
     3
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
     4
    Copyright   1999  University of Cambridge
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
     5
9433
ac20534ce4d1 avoid referencing thy value;
wenzelm
parents: 9108
diff changeset
     6
Binary arithmetic for the reals (integer literals only).
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
     7
*)
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
     8
10919
144ede948e58 renamings: real_of_nat, real_of_int -> (overloaded) real
paulson
parents: 10890
diff changeset
     9
(** real (coercion from int to real) **)
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    10
10919
144ede948e58 renamings: real_of_nat, real_of_int -> (overloaded) real
paulson
parents: 10890
diff changeset
    11
Goal "real (number_of w :: int) = number_of w";
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    12
by (simp_tac (simpset() addsimps [real_number_of_def]) 1);
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    13
qed "real_number_of";
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    14
Addsimps [real_number_of];
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    15
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
    16
Goalw [real_number_of_def] "Numeral0 = (0::real)";
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    17
by (simp_tac (simpset() addsimps [real_of_int_zero RS sym]) 1);
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
    18
qed "real_numeral_0_eq_0";
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    19
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
    20
Goalw [real_number_of_def] "Numeral1 = (1::real)";
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    21
by (simp_tac (simpset() addsimps [real_of_int_one RS sym]) 1);
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
    22
qed "real_numeral_1_eq_1";
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    23
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    24
(** Addition **)
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    25
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    26
Goal "(number_of v :: real) + number_of v' = number_of (bin_add v v')";
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    27
by (simp_tac
9433
ac20534ce4d1 avoid referencing thy value;
wenzelm
parents: 9108
diff changeset
    28
    (HOL_ss addsimps [real_number_of_def, 
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    29
				  real_of_int_add, number_of_add]) 1);
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    30
qed "add_real_number_of";
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    31
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    32
Addsimps [add_real_number_of];
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    33
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    34
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    35
(** Subtraction **)
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    36
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    37
Goalw [real_number_of_def] "- (number_of w :: real) = number_of (bin_minus w)";
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    38
by (simp_tac
9433
ac20534ce4d1 avoid referencing thy value;
wenzelm
parents: 9108
diff changeset
    39
    (HOL_ss addsimps [number_of_minus, real_of_int_minus]) 1);
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    40
qed "minus_real_number_of";
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    41
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    42
Goalw [real_number_of_def]
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    43
   "(number_of v :: real) - number_of w = number_of (bin_add v (bin_minus w))";
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    44
by (simp_tac
9433
ac20534ce4d1 avoid referencing thy value;
wenzelm
parents: 9108
diff changeset
    45
    (HOL_ss addsimps [diff_number_of_eq, real_of_int_diff]) 1);
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    46
qed "diff_real_number_of";
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    47
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    48
Addsimps [minus_real_number_of, diff_real_number_of];
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    49
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    50
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    51
(** Multiplication **)
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    52
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    53
Goal "(number_of v :: real) * number_of v' = number_of (bin_mult v v')";
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    54
by (simp_tac
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
    55
    (HOL_ss addsimps [real_number_of_def, real_of_int_mult, 
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
    56
                      number_of_mult]) 1);
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    57
qed "mult_real_number_of";
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    58
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    59
Addsimps [mult_real_number_of];
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    60
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
    61
Goal "(2::real) = 1 + 1";
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
    62
by (simp_tac (simpset() addsimps [real_numeral_1_eq_1 RS sym]) 1);
7588
26384af93359 Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents: 7583
diff changeset
    63
val lemma = result();
26384af93359 Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents: 7583
diff changeset
    64
26384af93359 Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents: 7583
diff changeset
    65
(*For specialist use: NOT as default simprules*)
11704
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
    66
Goal "2 * z = (z+z::real)";
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
    67
by (simp_tac (simpset () addsimps [lemma, real_add_mult_distrib]) 1);
7588
26384af93359 Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents: 7583
diff changeset
    68
qed "real_mult_2";
26384af93359 Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents: 7583
diff changeset
    69
11704
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
    70
Goal "z * 2 = (z+z::real)";
7588
26384af93359 Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents: 7583
diff changeset
    71
by (stac real_mult_commute 1 THEN rtac real_mult_2 1);
26384af93359 Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents: 7583
diff changeset
    72
qed "real_mult_2_right";
26384af93359 Tidying to exploit the new arith_tac. RealBin no longer imports RealPow or
paulson
parents: 7583
diff changeset
    73
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    74
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    75
(*** Comparisons ***)
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    76
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    77
(** Equals (=) **)
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    78
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    79
Goal "((number_of v :: real) = number_of v') = \
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    80
\     iszero (number_of (bin_add v (bin_minus v')))";
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    81
by (simp_tac
9433
ac20534ce4d1 avoid referencing thy value;
wenzelm
parents: 9108
diff changeset
    82
    (HOL_ss addsimps [real_number_of_def, 
11597
cd6d2eddf75f renamed real_of_int_eq_iff to real_of_int_inject;
wenzelm
parents: 10919
diff changeset
    83
	              real_of_int_inject, eq_number_of_eq]) 1);
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    84
qed "eq_real_number_of";
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    85
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    86
Addsimps [eq_real_number_of];
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    87
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    88
(** Less-than (<) **)
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    89
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    90
(*"neg" is used in rewrite rules for binary comparisons*)
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    91
Goal "((number_of v :: real) < number_of v') = \
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    92
\     neg (number_of (bin_add v (bin_minus v')))";
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    93
by (simp_tac
9433
ac20534ce4d1 avoid referencing thy value;
wenzelm
parents: 9108
diff changeset
    94
    (HOL_ss addsimps [real_number_of_def, real_of_int_less_iff, 
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    95
				  less_number_of_eq_neg]) 1);
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    96
qed "less_real_number_of";
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    97
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    98
Addsimps [less_real_number_of];
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
    99
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
   100
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
   101
(** Less-than-or-equals (<=) **)
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
   102
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
   103
Goal "(number_of x <= (number_of y::real)) = \
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
   104
\     (~ number_of y < (number_of x::real))";
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
   105
by (rtac (linorder_not_less RS sym) 1);
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
   106
qed "le_real_number_of_eq_not_less"; 
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
   107
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
   108
Addsimps [le_real_number_of_eq_not_less];
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
   109
11713
883d559b0b8c sane numerals (stage 3): provide generic "1" on all number types;
wenzelm
parents: 11704
diff changeset
   110
(*** New versions of existing theorems involving 0, 1 ***)
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
   111
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   112
Goal "- 1 = (-1::real)";
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   113
by (simp_tac (simpset() addsimps [real_numeral_1_eq_1 RS sym]) 1);
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   114
qed "real_minus_1_eq_m1";
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   115
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   116
Goal "-1 * z = -(z::real)";
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   117
by (simp_tac (simpset() addsimps [real_minus_1_eq_m1 RS sym, 
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   118
                                  real_mult_minus_1]) 1);
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   119
qed "real_mult_minus1";
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   120
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   121
Goal "z * -1 = -(z::real)";
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   122
by (stac real_mult_commute 1 THEN rtac real_mult_minus1 1);
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   123
qed "real_mult_minus1_right";
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   124
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   125
Addsimps [real_mult_minus1, real_mult_minus1_right];
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
   126
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
   127
11713
883d559b0b8c sane numerals (stage 3): provide generic "1" on all number types;
wenzelm
parents: 11704
diff changeset
   128
(*Maps 0 to Numeral0 and 1 to Numeral1 and -(Numeral1) to -1*)
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
   129
val real_numeral_ss = 
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   130
    HOL_ss addsimps [real_numeral_0_eq_0 RS sym, real_numeral_1_eq_1 RS sym, 
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   131
		     real_minus_1_eq_m1];
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
   132
9433
ac20534ce4d1 avoid referencing thy value;
wenzelm
parents: 9108
diff changeset
   133
fun rename_numerals th = 
ac20534ce4d1 avoid referencing thy value;
wenzelm
parents: 9108
diff changeset
   134
    asm_full_simplify real_numeral_ss (Thm.transfer (the_context ()) th);
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
   135
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
   136
10919
144ede948e58 renamings: real_of_nat, real_of_int -> (overloaded) real
paulson
parents: 10890
diff changeset
   137
(** real from type "nat" **)
7292
dff3470c5c62 real literals using binary arithmetic
paulson
parents:
diff changeset
   138
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   139
Goal "(0 < real (n::nat)) = (0<n)";
10784
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   140
by (simp_tac (HOL_ss addsimps [real_of_nat_less_iff, 
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   141
                               real_of_nat_zero RS sym]) 1);
10784
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   142
qed "zero_less_real_of_nat_iff";
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   143
AddIffs [zero_less_real_of_nat_iff];
7583
d1b40e0464b1 Restructured lin.arith.package and fixed a proof in RComplete.
nipkow
parents: 7292
diff changeset
   144
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   145
Goal "(0 <= real (n::nat)) = (0<=n)";
10784
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   146
by (simp_tac (HOL_ss addsimps [real_of_nat_le_iff, 
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   147
                               real_of_nat_zero RS sym]) 1);
10784
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   148
qed "zero_le_real_of_nat_iff";
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   149
AddIffs [zero_le_real_of_nat_iff];
7583
d1b40e0464b1 Restructured lin.arith.package and fixed a proof in RComplete.
nipkow
parents: 7292
diff changeset
   150
9013
9dd0274f76af Updated files to remove 0r and 1r from theorems in descendant theories
fleuriot
parents: 8838
diff changeset
   151
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   152
(*Like the ones above, for "equals"*)
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   153
AddIffs [real_of_nat_zero_iff];
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   154
9043
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   155
(** Simplification of arithmetic when nested to the right **)
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   156
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   157
Goal "number_of v + (number_of w + z) = (number_of(bin_add v w) + z::real)";
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   158
by Auto_tac; 
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   159
qed "real_add_number_of_left";
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   160
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   161
Goal "number_of v * (number_of w * z) = (number_of(bin_mult v w) * z::real)";
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   162
by (simp_tac (simpset() addsimps [real_mult_assoc RS sym]) 1);
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   163
qed "real_mult_number_of_left";
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   164
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   165
Goalw [real_diff_def]
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   166
     "number_of v + (number_of w - c) = number_of(bin_add v w) - (c::real)";
9043
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   167
by (rtac real_add_number_of_left 1);
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   168
qed "real_add_number_of_diff1";
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   169
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   170
Goal "number_of v + (c - number_of w) = \
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   171
\     number_of (bin_add v (bin_minus w)) + (c::real)";
9043
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   172
by (stac (diff_real_number_of RS sym) 1);
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   173
by Auto_tac;
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   174
qed "real_add_number_of_diff2";
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   175
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   176
Addsimps [real_add_number_of_left, real_mult_number_of_left,
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   177
	  real_add_number_of_diff1, real_add_number_of_diff2]; 
ca761fe227d8 First round of changes, towards installation of simprocs
paulson
parents: 9013
diff changeset
   178
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   179
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   180
(*"neg" is used in rewrite rules for binary comparisons*)
10919
144ede948e58 renamings: real_of_nat, real_of_int -> (overloaded) real
paulson
parents: 10890
diff changeset
   181
Goal "real (number_of v :: nat) = \
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   182
\       (if neg (number_of v) then 0 \
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   183
\        else (number_of v :: real))";
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   184
by (simp_tac
9433
ac20534ce4d1 avoid referencing thy value;
wenzelm
parents: 9108
diff changeset
   185
    (HOL_ss addsimps [nat_number_of_def, real_of_nat_real_of_int,
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   186
                      real_of_nat_neg_int, real_number_of,
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   187
                      real_numeral_0_eq_0 RS sym]) 1);
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   188
qed "real_of_nat_number_of";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   189
Addsimps [real_of_nat_number_of];
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   190
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   191
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   192
(**** Simprocs for numeric literals ****)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   193
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   194
(** Combining of literal coefficients in sums of products **)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   195
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   196
Goal "(x < y) = (x-y < (0::real))";
9080
67ca888af420 fixed the installation of linear arithmetic for the reals
paulson
parents: 9068
diff changeset
   197
by (simp_tac (simpset() addsimps [real_diff_less_eq]) 1);   
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   198
qed "real_less_iff_diff_less_0";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   199
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   200
Goal "(x = y) = (x-y = (0::real))";
9080
67ca888af420 fixed the installation of linear arithmetic for the reals
paulson
parents: 9068
diff changeset
   201
by (simp_tac (simpset() addsimps [real_diff_eq_eq]) 1);   
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   202
qed "real_eq_iff_diff_eq_0";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   203
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   204
Goal "(x <= y) = (x-y <= (0::real))";
9080
67ca888af420 fixed the installation of linear arithmetic for the reals
paulson
parents: 9068
diff changeset
   205
by (simp_tac (simpset() addsimps [real_diff_le_eq]) 1);   
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   206
qed "real_le_iff_diff_le_0";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   207
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   208
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   209
(** For combine_numerals **)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   210
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   211
Goal "i*u + (j*u + k) = (i+j)*u + (k::real)";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   212
by (asm_simp_tac (simpset() addsimps [real_add_mult_distrib]) 1);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   213
qed "left_real_add_mult_distrib";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   214
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   215
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   216
(** For cancel_numerals **)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   217
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   218
val rel_iff_rel_0_rls = map (inst "y" "?u+?v")
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   219
                          [real_less_iff_diff_less_0, real_eq_iff_diff_eq_0, 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   220
			   real_le_iff_diff_le_0] @
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   221
		        map (inst "y" "n")
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   222
                          [real_less_iff_diff_less_0, real_eq_iff_diff_eq_0, 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   223
			   real_le_iff_diff_le_0];
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   224
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   225
Goal "!!i::real. (i*u + m = j*u + n) = ((i-j)*u + m = n)";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   226
by (asm_simp_tac (simpset() addsimps [real_diff_def, real_add_mult_distrib]@
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   227
		                     real_add_ac@rel_iff_rel_0_rls) 1);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   228
qed "real_eq_add_iff1";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   229
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   230
Goal "!!i::real. (i*u + m = j*u + n) = (m = (j-i)*u + n)";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   231
by (asm_simp_tac (simpset() addsimps [real_diff_def, real_add_mult_distrib]@
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   232
                                     real_add_ac@rel_iff_rel_0_rls) 1);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   233
qed "real_eq_add_iff2";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   234
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   235
Goal "!!i::real. (i*u + m < j*u + n) = ((i-j)*u + m < n)";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   236
by (asm_simp_tac (simpset() addsimps [real_diff_def, real_add_mult_distrib]@
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   237
                                     real_add_ac@rel_iff_rel_0_rls) 1);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   238
qed "real_less_add_iff1";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   239
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   240
Goal "!!i::real. (i*u + m < j*u + n) = (m < (j-i)*u + n)";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   241
by (asm_simp_tac (simpset() addsimps [real_diff_def, real_add_mult_distrib]@
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   242
                                     real_add_ac@rel_iff_rel_0_rls) 1);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   243
qed "real_less_add_iff2";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   244
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   245
Goal "!!i::real. (i*u + m <= j*u + n) = ((i-j)*u + m <= n)";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   246
by (asm_simp_tac (simpset() addsimps [real_diff_def, real_add_mult_distrib]@
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   247
                                     real_add_ac@rel_iff_rel_0_rls) 1);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   248
qed "real_le_add_iff1";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   249
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   250
Goal "!!i::real. (i*u + m <= j*u + n) = (m <= (j-i)*u + n)";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   251
by (asm_simp_tac (simpset() addsimps [real_diff_def, real_add_mult_distrib]
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   252
                                     @real_add_ac@rel_iff_rel_0_rls) 1);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   253
qed "real_le_add_iff2";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   254
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   255
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   256
Addsimps [real_numeral_0_eq_0, real_numeral_1_eq_1];
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   257
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   258
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   259
structure Real_Numeral_Simprocs =
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   260
struct
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   261
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   262
(*Maps 0 to Numeral0 and 1 to Numeral1 so that arithmetic in simprocs
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   263
  isn't complicated by the abstract 0 and 1.*)
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   264
val numeral_syms = [real_numeral_0_eq_0 RS sym, real_numeral_1_eq_1 RS sym];
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   265
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   266
(*Utilities*)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   267
10693
9e4a0e84d0d6 moved mk_bin from Numerals to HOLogic
nipkow
parents: 10689
diff changeset
   268
fun mk_numeral n = HOLogic.number_of_const HOLogic.realT $ HOLogic.mk_bin n;
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   269
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   270
(*Decodes a binary real constant, or 0, 1*)
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   271
fun dest_numeral (Const("0", _)) = 0
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   272
  | dest_numeral (Const("1", _)) = 1
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   273
  | dest_numeral (Const("Numeral.number_of", _) $ w) = 
10890
0b4e916f51ed HOLogic.dest_binum;
wenzelm
parents: 10784
diff changeset
   274
     (HOLogic.dest_binum w
0b4e916f51ed HOLogic.dest_binum;
wenzelm
parents: 10784
diff changeset
   275
      handle TERM _ => raise TERM("Real_Numeral_Simprocs.dest_numeral:1", [w]))
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   276
  | dest_numeral t = raise TERM("Real_Numeral_Simprocs.dest_numeral:2", [t]);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   277
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   278
fun find_first_numeral past (t::terms) =
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   279
	((dest_numeral t, rev past @ terms)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   280
	 handle TERM _ => find_first_numeral (t::past) terms)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   281
  | find_first_numeral past [] = raise TERM("find_first_numeral", []);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   282
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   283
val zero = mk_numeral 0;
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   284
val mk_plus = HOLogic.mk_binop "op +";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   285
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   286
val uminus_const = Const ("uminus", HOLogic.realT --> HOLogic.realT);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   287
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   288
(*Thus mk_sum[t] yields t+0; longer sums don't have a trailing zero*)
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   289
fun mk_sum []        = zero
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   290
  | mk_sum [t,u]     = mk_plus (t, u)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   291
  | mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   292
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   293
(*this version ALWAYS includes a trailing zero*)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   294
fun long_mk_sum []        = zero
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   295
  | long_mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   296
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   297
val dest_plus = HOLogic.dest_bin "op +" HOLogic.realT;
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   298
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   299
(*decompose additions AND subtractions as a sum*)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   300
fun dest_summing (pos, Const ("op +", _) $ t $ u, ts) =
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   301
        dest_summing (pos, t, dest_summing (pos, u, ts))
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   302
  | dest_summing (pos, Const ("op -", _) $ t $ u, ts) =
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   303
        dest_summing (pos, t, dest_summing (not pos, u, ts))
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   304
  | dest_summing (pos, t, ts) =
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   305
	if pos then t::ts else uminus_const$t :: ts;
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   306
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   307
fun dest_sum t = dest_summing (true, t, []);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   308
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   309
val mk_diff = HOLogic.mk_binop "op -";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   310
val dest_diff = HOLogic.dest_bin "op -" HOLogic.realT;
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   311
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   312
val one = mk_numeral 1;
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   313
val mk_times = HOLogic.mk_binop "op *";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   314
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   315
fun mk_prod [] = one
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   316
  | mk_prod [t] = t
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   317
  | mk_prod (t :: ts) = if t = one then mk_prod ts
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   318
                        else mk_times (t, mk_prod ts);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   319
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   320
val dest_times = HOLogic.dest_bin "op *" HOLogic.realT;
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   321
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   322
fun dest_prod t =
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   323
      let val (t,u) = dest_times t 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   324
      in  dest_prod t @ dest_prod u  end
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   325
      handle TERM _ => [t];
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   326
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   327
(*DON'T do the obvious simplifications; that would create special cases*) 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   328
fun mk_coeff (k, ts) = mk_times (mk_numeral k, ts);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   329
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   330
(*Express t as a product of (possibly) a numeral with other sorted terms*)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   331
fun dest_coeff sign (Const ("uminus", _) $ t) = dest_coeff (~sign) t
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   332
  | dest_coeff sign t =
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   333
    let val ts = sort Term.term_ord (dest_prod t)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   334
	val (n, ts') = find_first_numeral [] ts
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   335
                          handle TERM _ => (1, ts)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   336
    in (sign*n, mk_prod ts') end;
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   337
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   338
(*Find first coefficient-term THAT MATCHES u*)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   339
fun find_first_coeff past u [] = raise TERM("find_first_coeff", []) 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   340
  | find_first_coeff past u (t::terms) =
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   341
	let val (n,u') = dest_coeff 1 t
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   342
	in  if u aconv u' then (n, rev past @ terms)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   343
			  else find_first_coeff (t::past) u terms
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   344
	end
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   345
	handle TERM _ => find_first_coeff (t::past) u terms;
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   346
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   347
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   348
(*Simplify Numeral0+n, n+Numeral0, Numeral1*n, n*Numeral1*)
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   349
val add_0s  = map rename_numerals [real_add_zero_left, real_add_zero_right];
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   350
val mult_1s = map rename_numerals [real_mult_1, real_mult_1_right] @
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   351
              [real_mult_minus1, real_mult_minus1_right];
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   352
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   353
(*To perform binary arithmetic*)
9108
9fff97d29837 bind_thm(s);
wenzelm
parents: 9080
diff changeset
   354
val bin_simps =
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   355
    [real_numeral_0_eq_0 RS sym, real_numeral_1_eq_1 RS sym,
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   356
     add_real_number_of, real_add_number_of_left, minus_real_number_of, 
10648
a8c647cfa31f first stage in tidying up Real and Hyperreal.
paulson
parents: 10606
diff changeset
   357
     diff_real_number_of, mult_real_number_of, real_mult_number_of_left] @ 
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   358
    bin_arith_simps @ bin_rel_simps;
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   359
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   360
(*To evaluate binary negations of coefficients*)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   361
val real_minus_simps = NCons_simps @
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   362
                   [real_minus_1_eq_m1, minus_real_number_of, 
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   363
		    bin_minus_1, bin_minus_0, bin_minus_Pls, bin_minus_Min,
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   364
		    bin_pred_1, bin_pred_0, bin_pred_Pls, bin_pred_Min];
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   365
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   366
(*To let us treat subtraction as addition*)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   367
val diff_simps = [real_diff_def, real_minus_add_distrib, real_minus_minus];
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   368
10699
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   369
(*push the unary minus down: - x * y = x * - y *)
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   370
val real_minus_mult_eq_1_to_2 = 
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   371
    [real_minus_mult_eq1 RS sym, real_minus_mult_eq2] MRS trans |> standard;
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   372
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   373
(*to extract again any uncancelled minuses*)
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   374
val real_minus_from_mult_simps = 
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   375
    [real_minus_minus, real_minus_mult_eq1 RS sym, real_minus_mult_eq2 RS sym];
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   376
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   377
(*combine unary minus with numeric literals, however nested within a product*)
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   378
val real_mult_minus_simps =
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   379
    [real_mult_assoc, real_minus_mult_eq1, real_minus_mult_eq_1_to_2];
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   380
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   381
(*Apply the given rewrite (if present) just once*)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   382
fun trans_tac None      = all_tac
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   383
  | trans_tac (Some th) = ALLGOALS (rtac (th RS trans));
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   384
9544
f9202e219a29 added a dummy "thm list" argument to prove_conv for the new interface to
paulson
parents: 9433
diff changeset
   385
fun prove_conv name tacs sg (hyps: thm list) (t,u) =
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   386
  if t aconv u then None
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   387
  else
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   388
  let val ct = cterm_of sg (HOLogic.mk_Trueprop (HOLogic.mk_eq (t, u)))
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   389
  in Some
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   390
     (prove_goalw_cterm [] ct (K tacs)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   391
      handle ERROR => error 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   392
	  ("The error(s) above occurred while trying to prove " ^
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   393
	   string_of_cterm ct ^ "\nInternal failure of simproc " ^ name))
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   394
  end;
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   395
9544
f9202e219a29 added a dummy "thm list" argument to prove_conv for the new interface to
paulson
parents: 9433
diff changeset
   396
(*version without the hyps argument*)
f9202e219a29 added a dummy "thm list" argument to prove_conv for the new interface to
paulson
parents: 9433
diff changeset
   397
fun prove_conv_nohyps name tacs sg = prove_conv name tacs sg [];
f9202e219a29 added a dummy "thm list" argument to prove_conv for the new interface to
paulson
parents: 9433
diff changeset
   398
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   399
(*Final simplification: cancel + and *  *)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   400
val simplify_meta_eq = 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   401
    Int_Numeral_Simprocs.simplify_meta_eq
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   402
         [real_add_zero_left, real_add_zero_right,
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   403
 	  real_mult_0, real_mult_0_right, real_mult_1, real_mult_1_right];
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   404
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   405
fun prep_simproc (name, pats, proc) = Simplifier.mk_simproc name pats proc;
12338
de0f4a63baa5 renamed class "term" to "type" (actually "HOL.type");
wenzelm
parents: 12018
diff changeset
   406
fun prep_pat s = HOLogic.read_cterm (Theory.sign_of (the_context ())) s;
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   407
val prep_pats = map prep_pat;
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   408
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   409
structure CancelNumeralsCommon =
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   410
  struct
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   411
  val mk_sum    	= mk_sum
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   412
  val dest_sum		= dest_sum
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   413
  val mk_coeff		= mk_coeff
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   414
  val dest_coeff	= dest_coeff 1
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   415
  val find_first_coeff	= find_first_coeff []
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   416
  val trans_tac         = trans_tac
10699
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   417
  val norm_tac = 
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   418
     ALLGOALS (simp_tac (HOL_ss addsimps add_0s@mult_1s@diff_simps@
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   419
                                         real_minus_simps@real_add_ac))
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   420
     THEN ALLGOALS (simp_tac (HOL_ss addsimps bin_simps@real_mult_minus_simps))
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   421
     THEN ALLGOALS
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   422
              (simp_tac (HOL_ss addsimps real_minus_from_mult_simps@
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   423
                                         real_add_ac@real_mult_ac))
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   424
  val numeral_simp_tac	= ALLGOALS (simp_tac (HOL_ss addsimps add_0s@bin_simps))
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   425
  val simplify_meta_eq  = simplify_meta_eq
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   426
  end;
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   427
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   428
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   429
structure EqCancelNumerals = CancelNumeralsFun
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   430
 (open CancelNumeralsCommon
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   431
  val prove_conv = prove_conv "realeq_cancel_numerals"
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   432
  val mk_bal   = HOLogic.mk_eq
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   433
  val dest_bal = HOLogic.dest_bin "op =" HOLogic.realT
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   434
  val bal_add1 = real_eq_add_iff1 RS trans
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   435
  val bal_add2 = real_eq_add_iff2 RS trans
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   436
);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   437
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   438
structure LessCancelNumerals = CancelNumeralsFun
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   439
 (open CancelNumeralsCommon
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   440
  val prove_conv = prove_conv "realless_cancel_numerals"
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   441
  val mk_bal   = HOLogic.mk_binrel "op <"
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   442
  val dest_bal = HOLogic.dest_bin "op <" HOLogic.realT
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   443
  val bal_add1 = real_less_add_iff1 RS trans
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   444
  val bal_add2 = real_less_add_iff2 RS trans
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   445
);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   446
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   447
structure LeCancelNumerals = CancelNumeralsFun
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   448
 (open CancelNumeralsCommon
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   449
  val prove_conv = prove_conv "realle_cancel_numerals"
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   450
  val mk_bal   = HOLogic.mk_binrel "op <="
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   451
  val dest_bal = HOLogic.dest_bin "op <=" HOLogic.realT
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   452
  val bal_add1 = real_le_add_iff1 RS trans
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   453
  val bal_add2 = real_le_add_iff2 RS trans
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   454
);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   455
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   456
val cancel_numerals = 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   457
  map prep_simproc
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   458
   [("realeq_cancel_numerals",
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   459
     prep_pats ["(l::real) + m = n", "(l::real) = m + n", 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   460
		"(l::real) - m = n", "(l::real) = m - n", 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   461
		"(l::real) * m = n", "(l::real) = m * n"], 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   462
     EqCancelNumerals.proc),
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   463
    ("realless_cancel_numerals", 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   464
     prep_pats ["(l::real) + m < n", "(l::real) < m + n", 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   465
		"(l::real) - m < n", "(l::real) < m - n", 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   466
		"(l::real) * m < n", "(l::real) < m * n"], 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   467
     LessCancelNumerals.proc),
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   468
    ("realle_cancel_numerals", 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   469
     prep_pats ["(l::real) + m <= n", "(l::real) <= m + n", 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   470
		"(l::real) - m <= n", "(l::real) <= m - n", 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   471
		"(l::real) * m <= n", "(l::real) <= m * n"], 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   472
     LeCancelNumerals.proc)];
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   473
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   474
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   475
structure CombineNumeralsData =
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   476
  struct
9574
da0a964aa601 new structure field "add" for CombineNumerals
paulson
parents: 9544
diff changeset
   477
  val add		= op + : int*int -> int 
11704
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   478
  val mk_sum    	= long_mk_sum    (*to work for e.g. 2*x + 3*x *)
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   479
  val dest_sum		= dest_sum
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   480
  val mk_coeff		= mk_coeff
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   481
  val dest_coeff	= dest_coeff 1
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   482
  val left_distrib	= left_real_add_mult_distrib RS trans
9544
f9202e219a29 added a dummy "thm list" argument to prove_conv for the new interface to
paulson
parents: 9433
diff changeset
   483
  val prove_conv	= prove_conv_nohyps "real_combine_numerals"
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   484
  val trans_tac         = trans_tac
10699
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   485
  val norm_tac = 
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   486
     ALLGOALS (simp_tac (HOL_ss addsimps numeral_syms@add_0s@mult_1s@
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   487
                                   diff_simps@real_minus_simps@real_add_ac))
10699
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   488
     THEN ALLGOALS (simp_tac (HOL_ss addsimps bin_simps@real_mult_minus_simps))
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   489
     THEN ALLGOALS (simp_tac (HOL_ss addsimps real_minus_from_mult_simps@
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   490
                                              real_add_ac@real_mult_ac))
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   491
  val numeral_simp_tac	= ALLGOALS 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   492
                    (simp_tac (HOL_ss addsimps add_0s@bin_simps))
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   493
  val simplify_meta_eq  = 
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   494
	Int_Numeral_Simprocs.simplify_meta_eq (add_0s@mult_1s)
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   495
  end;
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   496
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   497
structure CombineNumerals = CombineNumeralsFun(CombineNumeralsData);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   498
  
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   499
val combine_numerals = 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   500
    prep_simproc ("real_combine_numerals",
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   501
		  prep_pats ["(i::real) + j", "(i::real) - j"],
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   502
		  CombineNumerals.proc);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   503
10689
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   504
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   505
(** Declarations for ExtractCommonTerm **)
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   506
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   507
(*this version ALWAYS includes a trailing one*)
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   508
fun long_mk_prod []        = one
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   509
  | long_mk_prod (t :: ts) = mk_times (t, mk_prod ts);
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   510
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   511
(*Find first term that matches u*)
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   512
fun find_first past u []         = raise TERM("find_first", []) 
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   513
  | find_first past u (t::terms) =
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   514
	if u aconv t then (rev past @ terms)
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   515
        else find_first (t::past) u terms
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   516
	handle TERM _ => find_first (t::past) u terms;
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   517
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   518
(*Final simplification: cancel + and *  *)
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   519
fun cancel_simplify_meta_eq cancel_th th = 
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   520
    Int_Numeral_Simprocs.simplify_meta_eq 
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   521
        [real_mult_1, real_mult_1_right] 
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   522
        (([th, cancel_th]) MRS trans);
5c44de6aadf4 loads the new simproc extract_common_term
paulson
parents: 10648
diff changeset
   523
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   524
(*** Making constant folding work for 0 and 1 too ***)
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   525
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   526
structure RealAbstractNumeralsData =
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   527
  struct
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   528
  val dest_eq         = HOLogic.dest_eq o HOLogic.dest_Trueprop o concl_of
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   529
  val is_numeral      = Bin_Simprocs.is_numeral
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   530
  val numeral_0_eq_0  = real_numeral_0_eq_0
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   531
  val numeral_1_eq_1  = real_numeral_1_eq_1
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   532
  val prove_conv      = prove_conv_nohyps "real_abstract_numerals"
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   533
  fun norm_tac simps  = ALLGOALS (simp_tac (HOL_ss addsimps simps))
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   534
  val simplify_meta_eq = Bin_Simprocs.simplify_meta_eq 
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   535
  end
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   536
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   537
structure RealAbstractNumerals = AbstractNumeralsFun (RealAbstractNumeralsData)
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   538
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   539
(*For addition, we already have rules for the operand 0.
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   540
  Multiplication is omitted because there are already special rules for 
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   541
  both 0 and 1 as operands.  Unary minus is trivial, just have - 1 = -1.
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   542
  For the others, having three patterns is a compromise between just having
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   543
  one (many spurious calls) and having nine (just too many!) *)
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   544
val eval_numerals = 
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   545
  map prep_simproc
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   546
   [("real_add_eval_numerals",
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   547
     prep_pats ["(m::real) + 1", "(m::real) + number_of v"], 
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   548
     RealAbstractNumerals.proc add_real_number_of),
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   549
    ("real_diff_eval_numerals",
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   550
     prep_pats ["(m::real) - 1", "(m::real) - number_of v"], 
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   551
     RealAbstractNumerals.proc diff_real_number_of),
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   552
    ("real_eq_eval_numerals",
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   553
     prep_pats ["(m::real) = 0", "(m::real) = 1", "(m::real) = number_of v"], 
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   554
     RealAbstractNumerals.proc eq_real_number_of),
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   555
    ("real_less_eval_numerals",
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   556
     prep_pats ["(m::real) < 0", "(m::real) < 1", "(m::real) < number_of v"], 
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   557
     RealAbstractNumerals.proc less_real_number_of),
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   558
    ("real_le_eval_numerals",
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   559
     prep_pats ["(m::real) <= 0", "(m::real) <= 1", "(m::real) <= number_of v"],
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   560
     RealAbstractNumerals.proc le_real_number_of_eq_not_less)]
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   561
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   562
end;
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   563
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   564
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   565
Addsimprocs Real_Numeral_Simprocs.eval_numerals;
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   566
Addsimprocs Real_Numeral_Simprocs.cancel_numerals;
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   567
Addsimprocs [Real_Numeral_Simprocs.combine_numerals];
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   568
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   569
(*The Abel_Cancel simprocs are now obsolete*)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   570
Delsimprocs [Real_Cancel.sum_conv, Real_Cancel.rel_conv];
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   571
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   572
(*examples:
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   573
print_depth 22;
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   574
set timing;
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   575
set trace_simp;
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   576
fun test s = (Goal s; by (Simp_tac 1)); 
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   577
11704
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   578
test "l + 2 + 2 + 2 + (l + 2) + (oo + 2) = (uu::real)";
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   579
11704
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   580
test "2*u = (u::real)";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   581
test "(i + j + 12 + (k::real)) - 15 = y";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   582
test "(i + j + 12 + (k::real)) - 5 = y";
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   583
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   584
test "y - b < (b::real)";
11704
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   585
test "y - (3*b + c) < (b::real) - 2*c";
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   586
11704
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   587
test "(2*x - (u*v) + y) - v*3*u = (w::real)";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   588
test "(2*x*u*v + (u*v)*4 + y) - v*u*4 = (w::real)";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   589
test "(2*x*u*v + (u*v)*4 + y) - v*u = (w::real)";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   590
test "u*v - (x*u*v + (u*v)*4 + y) = (w::real)";
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   591
11704
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   592
test "(i + j + 12 + (k::real)) = u + 15 + y";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   593
test "(i + j*2 + 12 + (k::real)) = j + 5 + y";
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   594
11704
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   595
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)";
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   596
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   597
test "a + -(b+c) + b = (d::real)";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   598
test "a + -(b+c) - b = (d::real)";
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   599
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   600
(*negative numerals*)
11704
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   601
test "(i + j + -2 + (k::real)) - (u + 5 + y) = zz";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   602
test "(i + j + -3 + (k::real)) < u + 5 + y";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   603
test "(i + j + 3 + (k::real)) < u + -6 + y";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   604
test "(i + j + -12 + (k::real)) - 15 = y";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   605
test "(i + j + 12 + (k::real)) - -15 = y";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   606
test "(i + j + -12 + (k::real)) - -15 = y";
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   607
*)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   608
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   609
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   610
(** Constant folding for real plus and times **)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   611
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   612
(*We do not need
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   613
    structure Real_Plus_Assoc = Assoc_Fold (Real_Plus_Assoc_Data);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   614
  because combine_numerals does the same thing*)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   615
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   616
structure Real_Times_Assoc_Data : ASSOC_FOLD_DATA =
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   617
struct
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   618
  val ss		= HOL_ss
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   619
  val eq_reflection	= eq_reflection
9433
ac20534ce4d1 avoid referencing thy value;
wenzelm
parents: 9108
diff changeset
   620
  val sg_ref    = Sign.self_ref (Theory.sign_of (the_context ()))
9068
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   621
  val T	     = HOLogic.realT
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   622
  val plus   = Const ("op *", [HOLogic.realT,HOLogic.realT] ---> HOLogic.realT)
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   623
  val add_ac = real_mult_ac
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   624
end;
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   625
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   626
structure Real_Times_Assoc = Assoc_Fold (Real_Times_Assoc_Data);
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   627
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   628
Addsimprocs [Real_Times_Assoc.conv];
202fdf72cf23 installing the cancel_numerals and combine_numerals simprocs
paulson
parents: 9043
diff changeset
   629
10699
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   630
(*Simplification of  x-y < 0, etc.*)
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   631
AddIffs [real_less_iff_diff_less_0 RS sym];
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   632
AddIffs [real_eq_iff_diff_eq_0 RS sym];
f0c3da8477e9 more tidying
paulson
parents: 10693
diff changeset
   633
AddIffs [real_le_iff_diff_le_0 RS sym];
10784
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   634
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   635
(** <= monotonicity results: needed for arithmetic **)
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   636
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   637
Goal "[| i <= j;  (0::real) <= k |] ==> i*k <= j*k";
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   638
by (auto_tac (claset(), 
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   639
              simpset() addsimps [order_le_less, real_mult_less_mono1]));  
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   640
qed "real_mult_le_mono1";
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   641
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   642
Goal "[| i <= j;  (0::real) <= k |] ==> k*i <= k*j";
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   643
by (dtac real_mult_le_mono1 1);
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   644
by (ALLGOALS (asm_full_simp_tac (simpset() addsimps [real_mult_commute])));
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   645
qed "real_mult_le_mono2";
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   646
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   647
Goal "[| (i::real) <= j;  k <= l;  0 <= j;  0 <= k |] ==> i*k <= j*l";
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   648
by (etac (real_mult_le_mono1 RS order_trans) 1);
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   649
by (assume_tac 1);
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   650
by (etac real_mult_le_mono2 1);
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   651
by (assume_tac 1);
27e4d90b35b5 more removal of obsolete rules
paulson
parents: 10752
diff changeset
   652
qed "real_mult_le_mono";
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   653
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11713
diff changeset
   654
Addsimps [real_minus_1_eq_m1];