src/HOL/Real/RealArith0.ML
author paulson
Sun, 07 Dec 2003 16:30:06 +0100
changeset 14284 f1abe67c448a
parent 14277 ad66687ece6e
child 14288 d149e3cbdb39
permissions -rw-r--r--
re-organisation of Real/RealArith0.ML; more `Isar scripts
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
     1
(*  Title:      HOL/Real/RealArith.ML
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
     2
    ID:         $Id$
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
     3
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
     4
    Copyright   1999  University of Cambridge
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
     5
14275
031a5a051bb4 Converting more of the "real" development to Isar scripts
paulson
parents: 14268
diff changeset
     6
Common factor cancellation
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
     7
*)
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
     8
14275
031a5a051bb4 Converting more of the "real" development to Isar scripts
paulson
parents: 14268
diff changeset
     9
val real_diff_minus_eq = thm"real_diff_minus_eq";
031a5a051bb4 Converting more of the "real" development to Isar scripts
paulson
parents: 14268
diff changeset
    10
val real_inverse_eq_divide = thm"real_inverse_eq_divide";
031a5a051bb4 Converting more of the "real" development to Isar scripts
paulson
parents: 14268
diff changeset
    11
val real_0_le_divide_iff = thm"real_0_le_divide_iff";
031a5a051bb4 Converting more of the "real" development to Isar scripts
paulson
parents: 14268
diff changeset
    12
val real_mult_less_cancel2 = thm"real_mult_less_cancel2";
031a5a051bb4 Converting more of the "real" development to Isar scripts
paulson
parents: 14268
diff changeset
    13
val real_mult_le_cancel2 = thm"real_mult_le_cancel2";
031a5a051bb4 Converting more of the "real" development to Isar scripts
paulson
parents: 14268
diff changeset
    14
val real_mult_less_cancel1 = thm"real_mult_less_cancel1";
031a5a051bb4 Converting more of the "real" development to Isar scripts
paulson
parents: 14268
diff changeset
    15
val real_mult_le_cancel1 = thm"real_mult_le_cancel1";
031a5a051bb4 Converting more of the "real" development to Isar scripts
paulson
parents: 14268
diff changeset
    16
val real_mult_eq_cancel1 = thm"real_mult_eq_cancel1";
031a5a051bb4 Converting more of the "real" development to Isar scripts
paulson
parents: 14268
diff changeset
    17
val real_mult_eq_cancel2 = thm"real_mult_eq_cancel2";
031a5a051bb4 Converting more of the "real" development to Isar scripts
paulson
parents: 14268
diff changeset
    18
val real_mult_div_cancel1 = thm"real_mult_div_cancel1";
031a5a051bb4 Converting more of the "real" development to Isar scripts
paulson
parents: 14268
diff changeset
    19
val real_mult_div_cancel_disj = thm"real_mult_div_cancel_disj";
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    20
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    21
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    22
local
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    23
  open Real_Numeral_Simprocs
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    24
in
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    25
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
    26
val rel_real_number_of = [eq_real_number_of, less_real_number_of,
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11704
diff changeset
    27
                          le_real_number_of_eq_not_less]
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    28
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    29
structure CancelNumeralFactorCommon =
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    30
  struct
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
    31
  val mk_coeff          = mk_coeff
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
    32
  val dest_coeff        = dest_coeff 1
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    33
  val trans_tac         = trans_tac
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
    34
  val norm_tac =
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11704
diff changeset
    35
     ALLGOALS (simp_tac (HOL_ss addsimps real_minus_from_mult_simps @ mult_1s))
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    36
     THEN ALLGOALS (simp_tac (HOL_ss addsimps bin_simps@real_mult_minus_simps))
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11704
diff changeset
    37
     THEN ALLGOALS (simp_tac (HOL_ss addsimps real_mult_ac))
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
    38
  val numeral_simp_tac  =
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    39
         ALLGOALS (simp_tac (HOL_ss addsimps rel_real_number_of@bin_simps))
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    40
  val simplify_meta_eq  = simplify_meta_eq
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    41
  end
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    42
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    43
structure DivCancelNumeralFactor = CancelNumeralFactorFun
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    44
 (open CancelNumeralFactorCommon
13485
acf39e924091 tuned prove_conv (error reporting done within meta_simplifier.ML);
wenzelm
parents: 13462
diff changeset
    45
  val prove_conv = Bin_Simprocs.prove_conv
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    46
  val mk_bal   = HOLogic.mk_binop "HOL.divide"
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    47
  val dest_bal = HOLogic.dest_bin "HOL.divide" HOLogic.realT
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    48
  val cancel = real_mult_div_cancel1 RS trans
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    49
  val neg_exchanges = false
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    50
)
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    51
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    52
structure EqCancelNumeralFactor = CancelNumeralFactorFun
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    53
 (open CancelNumeralFactorCommon
13485
acf39e924091 tuned prove_conv (error reporting done within meta_simplifier.ML);
wenzelm
parents: 13462
diff changeset
    54
  val prove_conv = Bin_Simprocs.prove_conv
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    55
  val mk_bal   = HOLogic.mk_eq
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    56
  val dest_bal = HOLogic.dest_bin "op =" HOLogic.realT
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    57
  val cancel = real_mult_eq_cancel1 RS trans
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    58
  val neg_exchanges = false
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    59
)
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    60
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    61
structure LessCancelNumeralFactor = CancelNumeralFactorFun
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    62
 (open CancelNumeralFactorCommon
13485
acf39e924091 tuned prove_conv (error reporting done within meta_simplifier.ML);
wenzelm
parents: 13462
diff changeset
    63
  val prove_conv = Bin_Simprocs.prove_conv
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    64
  val mk_bal   = HOLogic.mk_binrel "op <"
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    65
  val dest_bal = HOLogic.dest_bin "op <" HOLogic.realT
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    66
  val cancel = real_mult_less_cancel1 RS trans
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    67
  val neg_exchanges = true
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    68
)
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    69
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    70
structure LeCancelNumeralFactor = CancelNumeralFactorFun
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    71
 (open CancelNumeralFactorCommon
13485
acf39e924091 tuned prove_conv (error reporting done within meta_simplifier.ML);
wenzelm
parents: 13462
diff changeset
    72
  val prove_conv = Bin_Simprocs.prove_conv
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    73
  val mk_bal   = HOLogic.mk_binrel "op <="
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    74
  val dest_bal = HOLogic.dest_bin "op <=" HOLogic.realT
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    75
  val cancel = real_mult_le_cancel1 RS trans
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    76
  val neg_exchanges = true
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    77
)
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    78
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
    79
val real_cancel_numeral_factors_relations =
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    80
  map prep_simproc
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    81
   [("realeq_cancel_numeral_factor",
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
    82
     ["(l::real) * m = n", "(l::real) = m * n"],
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    83
     EqCancelNumeralFactor.proc),
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
    84
    ("realless_cancel_numeral_factor",
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
    85
     ["(l::real) * m < n", "(l::real) < m * n"],
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
    86
     LessCancelNumeralFactor.proc),
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
    87
    ("realle_cancel_numeral_factor",
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
    88
     ["(l::real) * m <= n", "(l::real) <= m * n"],
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11704
diff changeset
    89
     LeCancelNumeralFactor.proc)]
10752
c4f1bf2acf4c tidying, and separation of HOL-Hyperreal from HOL-Real
paulson
parents: 10722
diff changeset
    90
c4f1bf2acf4c tidying, and separation of HOL-Hyperreal from HOL-Real
paulson
parents: 10722
diff changeset
    91
val real_cancel_numeral_factors_divide = prep_simproc
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
    92
        ("realdiv_cancel_numeral_factor",
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
    93
         ["((l::real) * m) / n", "(l::real) / (m * n)",
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
    94
          "((number_of v)::real) / (number_of w)"],
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
    95
         DivCancelNumeralFactor.proc)
10752
c4f1bf2acf4c tidying, and separation of HOL-Hyperreal from HOL-Real
paulson
parents: 10722
diff changeset
    96
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
    97
val real_cancel_numeral_factors =
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
    98
    real_cancel_numeral_factors_relations @
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11704
diff changeset
    99
    [real_cancel_numeral_factors_divide]
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   100
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   101
end;
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   102
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   103
Addsimprocs real_cancel_numeral_factors;
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   104
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   105
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   106
(*examples:
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   107
print_depth 22;
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   108
set timing;
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   109
set trace_simp;
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
   110
fun test s = (Goal s; by (Simp_tac 1));
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   111
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11704
diff changeset
   112
test "0 <= (y::real) * -2";
11704
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   113
test "9*x = 12 * (y::real)";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   114
test "(9*x) / (12 * (y::real)) = z";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   115
test "9*x < 12 * (y::real)";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   116
test "9*x <= 12 * (y::real)";
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   117
11704
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   118
test "-99*x = 132 * (y::real)";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   119
test "(-99*x) / (132 * (y::real)) = z";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   120
test "-99*x < 132 * (y::real)";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   121
test "-99*x <= 132 * (y::real)";
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   122
11704
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   123
test "999*x = -396 * (y::real)";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   124
test "(999*x) / (-396 * (y::real)) = z";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   125
test "999*x < -396 * (y::real)";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   126
test "999*x <= -396 * (y::real)";
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   127
12018
ec054019c910 Numerals and simprocs for types real and hypreal. The abstract
paulson
parents: 11704
diff changeset
   128
test  "(- ((2::real) * x) <= 2 * y)";
11704
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   129
test "-99*x = -81 * (y::real)";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   130
test "(-99*x) / (-81 * (y::real)) = z";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   131
test "-99*x <= -81 * (y::real)";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   132
test "-99*x < -81 * (y::real)";
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   133
11704
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   134
test "-2 * x = -1 * (y::real)";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   135
test "-2 * x = -(y::real)";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   136
test "(-2 * x) / (-1 * (y::real)) = z";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   137
test "-2 * x < -(y::real)";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   138
test "-2 * x <= -1 * (y::real)";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   139
test "-x < -23 * (y::real)";
3c50a2cd6f00 * sane numerals (stage 2): plain "num" syntax (removed "#");
wenzelm
parents: 11701
diff changeset
   140
test "-x <= -23 * (y::real)";
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   141
*)
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   142
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   143
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   144
(** Declarations for ExtractCommonTerm **)
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   145
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   146
local
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   147
  open Real_Numeral_Simprocs
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   148
in
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   149
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   150
structure CancelFactorCommon =
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   151
  struct
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
   152
  val mk_sum            = long_mk_prod
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
   153
  val dest_sum          = dest_prod
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
   154
  val mk_coeff          = mk_coeff
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
   155
  val dest_coeff        = dest_coeff
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
   156
  val find_first        = find_first []
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   157
  val trans_tac         = trans_tac
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   158
  val norm_tac = ALLGOALS (simp_tac (HOL_ss addsimps mult_1s@real_mult_ac))
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   159
  end;
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   160
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   161
structure EqCancelFactor = ExtractCommonTermFun
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   162
 (open CancelFactorCommon
13485
acf39e924091 tuned prove_conv (error reporting done within meta_simplifier.ML);
wenzelm
parents: 13462
diff changeset
   163
  val prove_conv = Bin_Simprocs.prove_conv
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   164
  val mk_bal   = HOLogic.mk_eq
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   165
  val dest_bal = HOLogic.dest_bin "op =" HOLogic.realT
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   166
  val simplify_meta_eq  = cancel_simplify_meta_eq real_mult_eq_cancel1
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   167
);
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   168
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   169
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   170
structure DivideCancelFactor = ExtractCommonTermFun
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   171
 (open CancelFactorCommon
13485
acf39e924091 tuned prove_conv (error reporting done within meta_simplifier.ML);
wenzelm
parents: 13462
diff changeset
   172
  val prove_conv = Bin_Simprocs.prove_conv
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   173
  val mk_bal   = HOLogic.mk_binop "HOL.divide"
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   174
  val dest_bal = HOLogic.dest_bin "HOL.divide" HOLogic.realT
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   175
  val simplify_meta_eq  = cancel_simplify_meta_eq real_mult_div_cancel_disj
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   176
);
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   177
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
   178
val real_cancel_factor =
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   179
  map prep_simproc
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
   180
   [("real_eq_cancel_factor", ["(l::real) * m = n", "(l::real) = m * n"], EqCancelFactor.proc),
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
   181
    ("real_divide_cancel_factor", ["((l::real) * m) / n", "(l::real) / (m * n)"],
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   182
     DivideCancelFactor.proc)];
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   183
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   184
end;
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   185
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   186
Addsimprocs real_cancel_factor;
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   187
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   188
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   189
(*examples:
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   190
print_depth 22;
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   191
set timing;
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   192
set trace_simp;
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
   193
fun test s = (Goal s; by (Asm_simp_tac 1));
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   194
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   195
test "x*k = k*(y::real)";
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
   196
test "k = k*(y::real)";
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   197
test "a*(b*c) = (b::real)";
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   198
test "a*(b*c) = d*(b::real)*(x*a)";
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   199
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   200
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   201
test "(x*k) / (k*(y::real)) = (uu::real)";
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 12483
diff changeset
   202
test "(k) / (k*(y::real)) = (uu::real)";
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   203
test "(a*(b*c)) / ((b::real)) = (uu::real)";
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   204
test "(a*(b*c)) / (d*(b::real)*(x*a)) = (uu::real)";
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   205
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   206
(*FIXME: what do we do about this?*)
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   207
test "a*(b*c)/(y*z) = d*(b::real)*(x*a)/z";
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   208
*)
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   209
14284
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   210
val real_add_minus_iff = thm"real_add_minus_iff";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   211
val real_add_eq_0_iff = thm"real_add_eq_0_iff";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   212
val real_add_less_0_iff = thm"real_add_less_0_iff";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   213
val real_0_less_add_iff = thm"real_0_less_add_iff";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   214
val real_add_le_0_iff = thm"real_add_le_0_iff";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   215
val real_0_le_add_iff = thm"real_0_le_add_iff";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   216
val real_0_less_diff_iff = thm"real_0_less_diff_iff";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   217
val real_0_le_diff_iff = thm"real_0_le_diff_iff";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   218
val real_divide_eq_cancel2 = thm"real_divide_eq_cancel2";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   219
val real_divide_eq_cancel1 = thm"real_divide_eq_cancel1";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   220
val real_inverse_less_iff = thm"real_inverse_less_iff";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   221
val real_inverse_le_iff = thm"real_inverse_le_iff";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   222
val real_divide_1 = thm"real_divide_1";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   223
val real_divide_minus1 = thm"real_divide_minus1";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   224
val real_minus1_divide = thm"real_minus1_divide";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   225
val real_lbound_gt_zero = thm"real_lbound_gt_zero";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   226
val real_less_half_sum = thm"real_less_half_sum";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   227
val real_gt_half_sum = thm"real_gt_half_sum";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   228
val real_dense = thm"real_dense";
10722
55c8367bab05 rational linear arithmetic
nipkow
parents:
diff changeset
   229
14284
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   230
val pos_real_less_divide_eq = thm"pos_real_less_divide_eq";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   231
val neg_real_less_divide_eq = thm"neg_real_less_divide_eq";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   232
val pos_real_divide_less_eq = thm"pos_real_divide_less_eq";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   233
val neg_real_divide_less_eq = thm"neg_real_divide_less_eq";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   234
val pos_real_le_divide_eq = thm"pos_real_le_divide_eq";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   235
val neg_real_le_divide_eq = thm"neg_real_le_divide_eq";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   236
val pos_real_divide_le_eq = thm"pos_real_divide_le_eq";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   237
val neg_real_divide_le_eq = thm"neg_real_divide_le_eq";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   238
val real_eq_divide_eq = thm"real_eq_divide_eq";
f1abe67c448a re-organisation of Real/RealArith0.ML; more `Isar scripts
paulson
parents: 14277
diff changeset
   239
val real_divide_eq_eq = thm"real_divide_eq_eq";