src/HOL/Integ/IntArith.ML
author nipkow
Thu, 06 Jul 2000 15:38:26 +0200
changeset 9269 b62d5265b959
parent 9214 9454f30eacc7
child 9436 62bb04ab4b01
permissions -rw-r--r--
added zabs to arith_tac
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
7707
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
     1
(*  Title:      HOL/Integ/IntArith.thy
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
     2
    ID:         $Id$
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
     3
    Authors:    Larry Paulson and Tobias Nipkow
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
     4
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
     5
Simprocs and decision procedure for linear arithmetic.
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
     6
*)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
     7
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
     8
(*** Simprocs for numeric literals ***)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
     9
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
    10
(** Combining of literal coefficients in sums of products **)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
    11
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
    12
Goal "(x < y) = (x-y < (#0::int))";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
    13
by (simp_tac (simpset() addsimps zcompare_rls) 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
    14
qed "zless_iff_zdiff_zless_0";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
    15
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
    16
Goal "(x = y) = (x-y = (#0::int))";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
    17
by (simp_tac (simpset() addsimps zcompare_rls) 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
    18
qed "eq_iff_zdiff_eq_0";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
    19
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
    20
Goal "(x <= y) = (x-y <= (#0::int))";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
    21
by (simp_tac (simpset() addsimps zcompare_rls) 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
    22
qed "zle_iff_zdiff_zle_0";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
    23
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
    24
8785
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
    25
(** For combine_numerals **)
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
    26
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
    27
Goal "i*u + (j*u + k) = (i+j)*u + (k::int)";
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
    28
by (asm_simp_tac (simpset() addsimps [zadd_zmult_distrib]) 1);
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
    29
qed "left_zadd_zmult_distrib";
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
    30
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
    31
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    32
(** For cancel_numerals **)
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    33
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    34
val rel_iff_rel_0_rls = map (inst "y" "?u+?v")
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    35
                          [zless_iff_zdiff_zless_0, eq_iff_zdiff_eq_0, 
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    36
			   zle_iff_zdiff_zle_0] @
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    37
		        map (inst "y" "n")
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    38
                          [zless_iff_zdiff_zless_0, eq_iff_zdiff_eq_0, 
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    39
			   zle_iff_zdiff_zle_0];
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    40
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    41
Goal "!!i::int. (i*u + m = j*u + n) = ((i-j)*u + m = n)";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    42
by (asm_simp_tac (simpset() addsimps [zdiff_def, zadd_zmult_distrib]@
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    43
		                     zadd_ac@rel_iff_rel_0_rls) 1);
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    44
qed "eq_add_iff1";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    45
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    46
Goal "!!i::int. (i*u + m = j*u + n) = (m = (j-i)*u + n)";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    47
by (asm_simp_tac (simpset() addsimps [zdiff_def, zadd_zmult_distrib]@
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    48
                                     zadd_ac@rel_iff_rel_0_rls) 1);
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    49
qed "eq_add_iff2";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    50
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    51
Goal "!!i::int. (i*u + m < j*u + n) = ((i-j)*u + m < n)";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    52
by (asm_simp_tac (simpset() addsimps [zdiff_def, zadd_zmult_distrib]@
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    53
                                     zadd_ac@rel_iff_rel_0_rls) 1);
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    54
qed "less_add_iff1";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    55
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    56
Goal "!!i::int. (i*u + m < j*u + n) = (m < (j-i)*u + n)";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    57
by (asm_simp_tac (simpset() addsimps [zdiff_def, zadd_zmult_distrib]@
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    58
                                     zadd_ac@rel_iff_rel_0_rls) 1);
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    59
qed "less_add_iff2";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    60
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    61
Goal "!!i::int. (i*u + m <= j*u + n) = ((i-j)*u + m <= n)";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    62
by (asm_simp_tac (simpset() addsimps [zdiff_def, zadd_zmult_distrib]@
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    63
                                     zadd_ac@rel_iff_rel_0_rls) 1);
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    64
qed "le_add_iff1";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    65
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    66
Goal "!!i::int. (i*u + m <= j*u + n) = (m <= (j-i)*u + n)";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    67
by (asm_simp_tac (simpset() addsimps [zdiff_def, zadd_zmult_distrib]
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    68
                                     @zadd_ac@rel_iff_rel_0_rls) 1);
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    69
qed "le_add_iff2";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    70
8799
89e9deef4bcb simprocs now simplify the RHS of their result
paulson
parents: 8796
diff changeset
    71
(*To tidy up the result of a simproc.  Only the RHS will be simplified.*)
8834
074503906abf better simplification of the result of simprocs
paulson
parents: 8799
diff changeset
    72
Goal "u = u' ==> (t==u) == (t==u')";
8799
89e9deef4bcb simprocs now simplify the RHS of their result
paulson
parents: 8796
diff changeset
    73
by Auto_tac;
89e9deef4bcb simprocs now simplify the RHS of their result
paulson
parents: 8796
diff changeset
    74
qed "eq_cong2";
89e9deef4bcb simprocs now simplify the RHS of their result
paulson
parents: 8796
diff changeset
    75
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    76
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    77
structure Int_Numeral_Simprocs =
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    78
struct
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    79
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    80
(*Utilities*)
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    81
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    82
fun mk_numeral n = HOLogic.number_of_const HOLogic.intT $ 
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    83
                   NumeralSyntax.mk_bin n;
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    84
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    85
(*Decodes a binary INTEGER*)
8785
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
    86
fun dest_numeral (Const("Numeral.number_of", _) $ w) = 
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
    87
     (NumeralSyntax.dest_bin w
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
    88
      handle Match => raise TERM("Int_Numeral_Simprocs.dest_numeral:1", [w]))
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
    89
  | dest_numeral t = raise TERM("Int_Numeral_Simprocs.dest_numeral:2", [t]);
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    90
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    91
fun find_first_numeral past (t::terms) =
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    92
	((dest_numeral t, rev past @ terms)
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    93
	 handle TERM _ => find_first_numeral (t::past) terms)
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    94
  | find_first_numeral past [] = raise TERM("find_first_numeral", []);
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    95
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    96
val zero = mk_numeral 0;
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    97
val mk_plus = HOLogic.mk_binop "op +";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    98
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
    99
val uminus_const = Const ("uminus", HOLogic.intT --> HOLogic.intT);
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   100
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   101
(*Thus mk_sum[t] yields t+#0; longer sums don't have a trailing zero*)
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   102
fun mk_sum []        = zero
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   103
  | mk_sum [t,u]     = mk_plus (t, u)
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   104
  | mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   105
8785
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   106
(*this version ALWAYS includes a trailing zero*)
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   107
fun long_mk_sum []        = zero
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   108
  | long_mk_sum (t :: ts) = mk_plus (t, mk_sum ts);
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   109
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   110
val dest_plus = HOLogic.dest_bin "op +" HOLogic.intT;
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   111
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   112
(*decompose additions AND subtractions as a sum*)
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   113
fun dest_summing (pos, Const ("op +", _) $ t $ u, ts) =
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   114
        dest_summing (pos, t, dest_summing (pos, u, ts))
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   115
  | dest_summing (pos, Const ("op -", _) $ t $ u, ts) =
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   116
        dest_summing (pos, t, dest_summing (not pos, u, ts))
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   117
  | dest_summing (pos, t, ts) =
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   118
	if pos then t::ts else uminus_const$t :: ts;
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   119
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   120
fun dest_sum t = dest_summing (true, t, []);
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   121
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   122
val mk_diff = HOLogic.mk_binop "op -";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   123
val dest_diff = HOLogic.dest_bin "op -" HOLogic.intT;
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   124
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   125
val one = mk_numeral 1;
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   126
val mk_times = HOLogic.mk_binop "op *";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   127
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   128
fun mk_prod [] = one
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   129
  | mk_prod [t] = t
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   130
  | mk_prod (t :: ts) = if t = one then mk_prod ts
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   131
                        else mk_times (t, mk_prod ts);
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   132
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   133
val dest_times = HOLogic.dest_bin "op *" HOLogic.intT;
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   134
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   135
fun dest_prod t =
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   136
      let val (t,u) = dest_times t 
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   137
      in  dest_prod t @ dest_prod u  end
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   138
      handle TERM _ => [t];
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   139
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   140
(*DON'T do the obvious simplifications; that would create special cases*) 
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   141
fun mk_coeff (k, ts) = mk_times (mk_numeral k, ts);
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   142
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   143
(*Express t as a product of (possibly) a numeral with other sorted terms*)
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   144
fun dest_coeff sign (Const ("uminus", _) $ t) = dest_coeff (~sign) t
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   145
  | dest_coeff sign t =
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   146
    let val ts = sort Term.term_ord (dest_prod t)
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   147
	val (n, ts') = find_first_numeral [] ts
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   148
                          handle TERM _ => (1, ts)
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   149
    in (sign*n, mk_prod ts') end;
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   150
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   151
(*Find first coefficient-term THAT MATCHES u*)
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   152
fun find_first_coeff past u [] = raise TERM("find_first_coeff", []) 
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   153
  | find_first_coeff past u (t::terms) =
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   154
	let val (n,u') = dest_coeff 1 t
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   155
	in  if u aconv u' then (n, rev past @ terms)
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   156
			  else find_first_coeff (t::past) u terms
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   157
	end
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   158
	handle TERM _ => find_first_coeff (t::past) u terms;
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   159
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   160
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   161
(*Simplify #1*n and n*#1 to n*)
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   162
val add_0s = [zadd_0, zadd_0_right];
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   163
val mult_1s = [zmult_1, zmult_1_right, zmult_minus1, zmult_minus1_right];
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   164
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   165
(*To perform binary arithmetic*)
9063
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   166
val bin_simps = [add_number_of_left] @ bin_arith_simps @ bin_rel_simps;
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   167
8787
9aeca9a34cf4 further tidying of integer simprocs
paulson
parents: 8785
diff changeset
   168
(*To evaluate binary negations of coefficients*)
9aeca9a34cf4 further tidying of integer simprocs
paulson
parents: 8785
diff changeset
   169
val zminus_simps = NCons_simps @
9aeca9a34cf4 further tidying of integer simprocs
paulson
parents: 8785
diff changeset
   170
                   [number_of_minus RS sym, 
9aeca9a34cf4 further tidying of integer simprocs
paulson
parents: 8785
diff changeset
   171
		    bin_minus_1, bin_minus_0, bin_minus_Pls, bin_minus_Min,
9aeca9a34cf4 further tidying of integer simprocs
paulson
parents: 8785
diff changeset
   172
		    bin_pred_1, bin_pred_0, bin_pred_Pls, bin_pred_Min];
9aeca9a34cf4 further tidying of integer simprocs
paulson
parents: 8785
diff changeset
   173
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   174
(*To let us treat subtraction as addition*)
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   175
val diff_simps = [zdiff_def, zminus_zadd_distrib, zminus_zminus];
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   176
8776
60821dbc9f18 now with combine_numerals
paulson
parents: 8763
diff changeset
   177
(*Apply the given rewrite (if present) just once*)
8799
89e9deef4bcb simprocs now simplify the RHS of their result
paulson
parents: 8796
diff changeset
   178
fun trans_tac None      = all_tac
89e9deef4bcb simprocs now simplify the RHS of their result
paulson
parents: 8796
diff changeset
   179
  | trans_tac (Some th) = ALLGOALS (rtac (th RS trans));
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   180
8776
60821dbc9f18 now with combine_numerals
paulson
parents: 8763
diff changeset
   181
fun prove_conv name tacs sg (t, u) =
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   182
  if t aconv u then None
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   183
  else
8799
89e9deef4bcb simprocs now simplify the RHS of their result
paulson
parents: 8796
diff changeset
   184
  let val ct = cterm_of sg (HOLogic.mk_Trueprop (HOLogic.mk_eq (t, u)))
89e9deef4bcb simprocs now simplify the RHS of their result
paulson
parents: 8796
diff changeset
   185
  in Some
89e9deef4bcb simprocs now simplify the RHS of their result
paulson
parents: 8796
diff changeset
   186
     (prove_goalw_cterm [] ct (K tacs)
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   187
      handle ERROR => error 
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   188
	  ("The error(s) above occurred while trying to prove " ^
8799
89e9deef4bcb simprocs now simplify the RHS of their result
paulson
parents: 8796
diff changeset
   189
	   string_of_cterm ct ^ "\nInternal failure of simproc " ^ name))
89e9deef4bcb simprocs now simplify the RHS of their result
paulson
parents: 8796
diff changeset
   190
  end;
89e9deef4bcb simprocs now simplify the RHS of their result
paulson
parents: 8796
diff changeset
   191
89e9deef4bcb simprocs now simplify the RHS of their result
paulson
parents: 8796
diff changeset
   192
fun simplify_meta_eq rules =
89e9deef4bcb simprocs now simplify the RHS of their result
paulson
parents: 8796
diff changeset
   193
    mk_meta_eq o
8834
074503906abf better simplification of the result of simprocs
paulson
parents: 8799
diff changeset
   194
    simplify (HOL_basic_ss addeqcongs[eq_cong2] addsimps rules)
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   195
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   196
fun prep_simproc (name, pats, proc) = Simplifier.mk_simproc name pats proc;
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   197
fun prep_pat s = Thm.read_cterm (Theory.sign_of Int.thy) (s, HOLogic.termT);
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   198
val prep_pats = map prep_pat;
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   199
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   200
structure CancelNumeralsCommon =
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   201
  struct
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   202
  val mk_sum    	= mk_sum
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   203
  val dest_sum		= dest_sum
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   204
  val mk_coeff		= mk_coeff
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   205
  val dest_coeff	= dest_coeff 1
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   206
  val find_first_coeff	= find_first_coeff []
8799
89e9deef4bcb simprocs now simplify the RHS of their result
paulson
parents: 8796
diff changeset
   207
  val trans_tac         = trans_tac
8776
60821dbc9f18 now with combine_numerals
paulson
parents: 8763
diff changeset
   208
  val norm_tac = ALLGOALS (simp_tac (HOL_ss addsimps add_0s@mult_1s@diff_simps@
8787
9aeca9a34cf4 further tidying of integer simprocs
paulson
parents: 8785
diff changeset
   209
                                                     zminus_simps@zadd_ac))
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   210
                 THEN ALLGOALS
8776
60821dbc9f18 now with combine_numerals
paulson
parents: 8763
diff changeset
   211
                    (simp_tac (HOL_ss addsimps [zmult_zminus_right RS sym]@
60821dbc9f18 now with combine_numerals
paulson
parents: 8763
diff changeset
   212
                                               bin_simps@zadd_ac@zmult_ac))
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   213
  val numeral_simp_tac	= ALLGOALS (simp_tac (HOL_ss addsimps add_0s@bin_simps))
8799
89e9deef4bcb simprocs now simplify the RHS of their result
paulson
parents: 8796
diff changeset
   214
  val simplify_meta_eq  = simplify_meta_eq (add_0s@mult_1s)
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   215
  end;
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   216
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   217
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   218
structure EqCancelNumerals = CancelNumeralsFun
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   219
 (open CancelNumeralsCommon
8776
60821dbc9f18 now with combine_numerals
paulson
parents: 8763
diff changeset
   220
  val prove_conv = prove_conv "inteq_cancel_numerals"
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   221
  val mk_bal   = HOLogic.mk_eq
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   222
  val dest_bal = HOLogic.dest_bin "op =" HOLogic.intT
8776
60821dbc9f18 now with combine_numerals
paulson
parents: 8763
diff changeset
   223
  val bal_add1 = eq_add_iff1 RS trans
60821dbc9f18 now with combine_numerals
paulson
parents: 8763
diff changeset
   224
  val bal_add2 = eq_add_iff2 RS trans
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   225
);
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   226
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   227
structure LessCancelNumerals = CancelNumeralsFun
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   228
 (open CancelNumeralsCommon
8776
60821dbc9f18 now with combine_numerals
paulson
parents: 8763
diff changeset
   229
  val prove_conv = prove_conv "intless_cancel_numerals"
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   230
  val mk_bal   = HOLogic.mk_binrel "op <"
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   231
  val dest_bal = HOLogic.dest_bin "op <" HOLogic.intT
8776
60821dbc9f18 now with combine_numerals
paulson
parents: 8763
diff changeset
   232
  val bal_add1 = less_add_iff1 RS trans
60821dbc9f18 now with combine_numerals
paulson
parents: 8763
diff changeset
   233
  val bal_add2 = less_add_iff2 RS trans
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   234
);
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   235
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   236
structure LeCancelNumerals = CancelNumeralsFun
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   237
 (open CancelNumeralsCommon
8776
60821dbc9f18 now with combine_numerals
paulson
parents: 8763
diff changeset
   238
  val prove_conv = prove_conv "intle_cancel_numerals"
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   239
  val mk_bal   = HOLogic.mk_binrel "op <="
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   240
  val dest_bal = HOLogic.dest_bin "op <=" HOLogic.intT
8776
60821dbc9f18 now with combine_numerals
paulson
parents: 8763
diff changeset
   241
  val bal_add1 = le_add_iff1 RS trans
60821dbc9f18 now with combine_numerals
paulson
parents: 8763
diff changeset
   242
  val bal_add2 = le_add_iff2 RS trans
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   243
);
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   244
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   245
val cancel_numerals = 
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   246
  map prep_simproc
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   247
   [("inteq_cancel_numerals",
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   248
     prep_pats ["(l::int) + m = n", "(l::int) = m + n", 
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   249
		"(l::int) - m = n", "(l::int) = m - n", 
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   250
		"(l::int) * m = n", "(l::int) = m * n"], 
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   251
     EqCancelNumerals.proc),
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   252
    ("intless_cancel_numerals", 
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   253
     prep_pats ["(l::int) + m < n", "(l::int) < m + n", 
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   254
		"(l::int) - m < n", "(l::int) < m - n", 
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   255
		"(l::int) * m < n", "(l::int) < m * n"], 
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   256
     LessCancelNumerals.proc),
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   257
    ("intle_cancel_numerals", 
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   258
     prep_pats ["(l::int) + m <= n", "(l::int) <= m + n", 
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   259
		"(l::int) - m <= n", "(l::int) <= m - n", 
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   260
		"(l::int) * m <= n", "(l::int) <= m * n"], 
8787
9aeca9a34cf4 further tidying of integer simprocs
paulson
parents: 8785
diff changeset
   261
     LeCancelNumerals.proc)];
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   262
8785
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   263
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   264
structure CombineNumeralsData =
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   265
  struct
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   266
  val mk_sum    	= long_mk_sum    (*to work for e.g. #2*x + #3*x *)
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   267
  val dest_sum		= dest_sum
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   268
  val mk_coeff		= mk_coeff
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   269
  val dest_coeff	= dest_coeff 1
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   270
  val left_distrib	= left_zadd_zmult_distrib RS trans
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   271
  val prove_conv	= prove_conv "int_combine_numerals"
8799
89e9deef4bcb simprocs now simplify the RHS of their result
paulson
parents: 8796
diff changeset
   272
  val trans_tac          = trans_tac
8785
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   273
  val norm_tac = ALLGOALS
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   274
                   (simp_tac (HOL_ss addsimps add_0s@mult_1s@diff_simps@
8787
9aeca9a34cf4 further tidying of integer simprocs
paulson
parents: 8785
diff changeset
   275
                                              zminus_simps@zadd_ac))
8785
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   276
                 THEN ALLGOALS
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   277
                    (simp_tac (HOL_ss addsimps [zmult_zminus_right RS sym]@
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   278
                                               bin_simps@zadd_ac@zmult_ac))
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   279
  val numeral_simp_tac	= ALLGOALS 
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   280
                    (simp_tac (HOL_ss addsimps add_0s@bin_simps))
8799
89e9deef4bcb simprocs now simplify the RHS of their result
paulson
parents: 8796
diff changeset
   281
  val simplify_meta_eq  = simplify_meta_eq (add_0s@mult_1s)
8785
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   282
  end;
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   283
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   284
structure CombineNumerals = CombineNumeralsFun(CombineNumeralsData);
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   285
  
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   286
val combine_numerals = 
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   287
    prep_simproc ("int_combine_numerals",
8787
9aeca9a34cf4 further tidying of integer simprocs
paulson
parents: 8785
diff changeset
   288
		  prep_pats ["(i::int) + j", "(i::int) - j"],
8785
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   289
		  CombineNumerals.proc);
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   290
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   291
end;
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   292
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   293
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   294
Addsimprocs Int_Numeral_Simprocs.cancel_numerals;
8785
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   295
Addsimprocs [Int_Numeral_Simprocs.combine_numerals];
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   296
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   297
(*The Abel_Cancel simprocs are now obsolete*)
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   298
Delsimprocs [Int_Cancel.sum_conv, Int_Cancel.rel_conv];
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   299
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   300
(*examples:
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   301
print_depth 22;
9000
c20d58286a51 cleaned up;
wenzelm
parents: 8834
diff changeset
   302
set timing;
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   303
set trace_simp;
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   304
fun test s = (Goal s; by (Simp_tac 1)); 
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   305
8785
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   306
test "l + #2 + #2 + #2 + (l + #2) + (oo + #2) = (uu::int)";
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   307
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   308
test "#2*u = (u::int)";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   309
test "(i + j + #12 + (k::int)) - #15 = y";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   310
test "(i + j + #12 + (k::int)) - #5 = y";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   311
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   312
test "y - b < (b::int)";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   313
test "y - (#3*b + c) < (b::int) - #2*c";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   314
8785
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   315
test "(#2*x - (u*v) + y) - v*#3*u = (w::int)";
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   316
test "(#2*x*u*v + (u*v)*#4 + y) - v*u*#4 = (w::int)";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   317
test "(#2*x*u*v + (u*v)*#4 + y) - v*u = (w::int)";
8785
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   318
test "u*v - (x*u*v + (u*v)*#4 + y) = (w::int)";
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   319
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   320
test "(i + j + #12 + (k::int)) = u + #15 + y";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   321
test "(i + j*#2 + #12 + (k::int)) = j + #5 + y";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   322
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   323
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::int)";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   324
8785
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   325
test "a + -(b+c) + b = (d::int)";
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   326
test "a + -(b+c) - b = (d::int)";
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   327
8763
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   328
(*negative numerals*)
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   329
test "(i + j + #-2 + (k::int)) - (u + #5 + y) = zz";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   330
test "(i + j + #-3 + (k::int)) < u + #5 + y";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   331
test "(i + j + #3 + (k::int)) < u + #-6 + y";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   332
test "(i + j + #-12 + (k::int)) - #15 = y";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   333
test "(i + j + #12 + (k::int)) - #-15 = y";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   334
test "(i + j + #-12 + (k::int)) - #-15 = y";
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   335
*)
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   336
22d4c641ebff now uses the new cancel_numerals simproc
paulson
parents: 8257
diff changeset
   337
7707
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   338
(** Constant folding for integer plus and times **)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   339
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   340
(*We do not need
8785
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   341
    structure Nat_Plus_Assoc = Assoc_Fold (Nat_Plus_Assoc_Data);
7707
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   342
    structure Int_Plus_Assoc = Assoc_Fold (Int_Plus_Assoc_Data);
8785
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   343
  because combine_numerals does the same thing*)
7707
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   344
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   345
structure Int_Times_Assoc_Data : ASSOC_FOLD_DATA =
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   346
struct
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   347
  val ss		= HOL_ss
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   348
  val eq_reflection	= eq_reflection
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   349
  val thy    = Bin.thy
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   350
  val T	     = HOLogic.intT
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   351
  val plus   = Const ("op *", [HOLogic.intT,HOLogic.intT] ---> HOLogic.intT);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   352
  val add_ac = zmult_ac
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   353
end;
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   354
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   355
structure Int_Times_Assoc = Assoc_Fold (Int_Times_Assoc_Data);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   356
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   357
Addsimprocs [Int_Times_Assoc.conv];
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   358
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   359
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   360
(** The same for the naturals **)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   361
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   362
structure Nat_Times_Assoc_Data : ASSOC_FOLD_DATA =
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   363
struct
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   364
  val ss		= HOL_ss
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   365
  val eq_reflection	= eq_reflection
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   366
  val thy    = Bin.thy
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   367
  val T	     = HOLogic.natT
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   368
  val plus   = Const ("op *", [HOLogic.natT,HOLogic.natT] ---> HOLogic.natT);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   369
  val add_ac = mult_ac
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   370
end;
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   371
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   372
structure Nat_Times_Assoc = Assoc_Fold (Nat_Times_Assoc_Data);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   373
8785
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   374
Addsimprocs [Nat_Times_Assoc.conv];
7707
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   375
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   376
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   377
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   378
(*** decision procedure for linear arithmetic ***)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   379
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   380
(*---------------------------------------------------------------------------*)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   381
(* Linear arithmetic                                                         *)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   382
(*---------------------------------------------------------------------------*)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   383
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   384
(*
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   385
Instantiation of the generic linear arithmetic package for int.
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   386
*)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   387
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   388
(* Update parameters of arithmetic prover *)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   389
let
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   390
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   391
(* reduce contradictory <= to False *)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   392
val add_rules = simp_thms @ bin_arith_simps @ bin_rel_simps @
8785
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   393
                [int_0, zadd_0, zadd_0_right, zdiff_def,
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   394
		 zadd_zminus_inverse, zadd_zminus_inverse2, 
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   395
		 zmult_0, zmult_0_right, 
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   396
		 zmult_1, zmult_1_right, 
9079
8e9b7095bf59 some missing simprules for integer linear arithmetic
paulson
parents: 9063
diff changeset
   397
		 zmult_minus1, zmult_minus1_right,
8e9b7095bf59 some missing simprules for integer linear arithmetic
paulson
parents: 9063
diff changeset
   398
		 zminus_zadd_distrib, zminus_zminus];
7707
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   399
8785
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   400
val simprocs = [Int_Times_Assoc.conv, Int_Numeral_Simprocs.combine_numerals]@
00cff9d083df Installation of CombineNumerals for the integers
paulson
parents: 8776
diff changeset
   401
               Int_Numeral_Simprocs.cancel_numerals;
7707
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   402
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   403
val add_mono_thms =
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   404
  map (fn s => prove_goal Int.thy s
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   405
                 (fn prems => [cut_facts_tac prems 1,
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   406
                      asm_simp_tac (simpset() addsimps [zadd_zle_mono]) 1]))
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   407
    ["(i <= j) & (k <= l) ==> i + k <= j + (l::int)",
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   408
     "(i  = j) & (k <= l) ==> i + k <= j + (l::int)",
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   409
     "(i <= j) & (k  = l) ==> i + k <= j + (l::int)",
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   410
     "(i  = j) & (k  = l) ==> i + k  = j + (l::int)"
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   411
    ];
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   412
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   413
in
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   414
LA_Data_Ref.add_mono_thms := !LA_Data_Ref.add_mono_thms @ add_mono_thms;
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   415
LA_Data_Ref.lessD := !LA_Data_Ref.lessD @ [add1_zle_eq RS iffD2];
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   416
LA_Data_Ref.ss_ref := !LA_Data_Ref.ss_ref addsimps add_rules
8796
4a3612f30865 if_weak_cong should make linear arithmetic faster
paulson
parents: 8787
diff changeset
   417
                      addsimprocs simprocs
4a3612f30865 if_weak_cong should make linear arithmetic faster
paulson
parents: 8787
diff changeset
   418
                      addcongs [if_weak_cong];
7707
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   419
LA_Data_Ref.discrete := !LA_Data_Ref.discrete @ [("IntDef.int",true)]
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   420
end;
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   421
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   422
let
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   423
val int_arith_simproc_pats =
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   424
  map (fn s => Thm.read_cterm (Theory.sign_of Int.thy) (s, HOLogic.boolT))
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   425
      ["(m::int) < n","(m::int) <= n", "(m::int) = n"];
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   426
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   427
val fast_int_arith_simproc = mk_simproc
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   428
  "fast_int_arith" int_arith_simproc_pats Fast_Arith.lin_arith_prover;
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   429
in
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   430
Addsimprocs [fast_int_arith_simproc]
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   431
end;
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   432
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   433
(* Some test data
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   434
Goal "!!a::int. [| a <= b; c <= d; x+y<z |] ==> a+c <= b+d";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   435
by (fast_arith_tac 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   436
Goal "!!a::int. [| a < b; c < d |] ==> a-d+ #2 <= b+(-c)";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   437
by (fast_arith_tac 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   438
Goal "!!a::int. [| a < b; c < d |] ==> a+c+ #1 < b+d";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   439
by (fast_arith_tac 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   440
Goal "!!a::int. [| a <= b; b+b <= c |] ==> a+a <= c";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   441
by (fast_arith_tac 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   442
Goal "!!a::int. [| a+b <= i+j; a<=b; i<=j |] \
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   443
\     ==> a+a <= j+j";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   444
by (fast_arith_tac 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   445
Goal "!!a::int. [| a+b < i+j; a<b; i<j |] \
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   446
\     ==> a+a - - #-1 < j+j - #3";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   447
by (fast_arith_tac 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   448
Goal "!!a::int. a+b+c <= i+j+k & a<=b & b<=c & i<=j & j<=k --> a+a+a <= k+k+k";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   449
by (arith_tac 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   450
Goal "!!a::int. [| a+b+c+d <= i+j+k+l; a<=b; b<=c; c<=d; i<=j; j<=k; k<=l |] \
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   451
\     ==> a <= l";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   452
by (fast_arith_tac 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   453
Goal "!!a::int. [| a+b+c+d <= i+j+k+l; a<=b; b<=c; c<=d; i<=j; j<=k; k<=l |] \
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   454
\     ==> a+a+a+a <= l+l+l+l";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   455
by (fast_arith_tac 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   456
Goal "!!a::int. [| a+b+c+d <= i+j+k+l; a<=b; b<=c; c<=d; i<=j; j<=k; k<=l |] \
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   457
\     ==> a+a+a+a+a <= l+l+l+l+i";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   458
by (fast_arith_tac 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   459
Goal "!!a::int. [| a+b+c+d <= i+j+k+l; a<=b; b<=c; c<=d; i<=j; j<=k; k<=l |] \
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   460
\     ==> a+a+a+a+a+a <= l+l+l+l+i+l";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   461
by (fast_arith_tac 1);
8257
fe9bf28e8a58 installed lin arith for nat numerals.
nipkow
parents: 7707
diff changeset
   462
Goal "!!a::int. [| a+b+c+d <= i+j+k+l; a<=b; b<=c; c<=d; i<=j; j<=k; k<=l |] \
fe9bf28e8a58 installed lin arith for nat numerals.
nipkow
parents: 7707
diff changeset
   463
\     ==> #6*a <= #5*l+i";
fe9bf28e8a58 installed lin arith for nat numerals.
nipkow
parents: 7707
diff changeset
   464
by (fast_arith_tac 1);
7707
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   465
*)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   466
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   467
(*---------------------------------------------------------------------------*)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   468
(* End of linear arithmetic                                                  *)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   469
(*---------------------------------------------------------------------------*)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   470
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   471
(** Simplification of inequalities involving numerical constants **)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   472
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   473
Goal "(w <= z - (#1::int)) = (w<(z::int))";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   474
by (arith_tac 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   475
qed "zle_diff1_eq";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   476
Addsimps [zle_diff1_eq];
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   477
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   478
Goal "(w < z + #1) = (w<=(z::int))";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   479
by (arith_tac 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   480
qed "zle_add1_eq_le";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   481
Addsimps [zle_add1_eq_le];
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   482
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   483
Goal "(z = z + w) = (w = (#0::int))";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   484
by (arith_tac 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   485
qed "zadd_left_cancel0";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   486
Addsimps [zadd_left_cancel0];
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   487
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   488
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   489
(* nat *)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   490
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   491
Goal "#0 <= z ==> int (nat z) = z"; 
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   492
by (asm_full_simp_tac
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   493
    (simpset() addsimps [neg_eq_less_0, zle_def, not_neg_nat]) 1); 
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   494
qed "nat_0_le"; 
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   495
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   496
Goal "z <= #0 ==> nat z = 0"; 
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   497
by (case_tac "z = #0" 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   498
by (asm_simp_tac (simpset() addsimps [nat_le_int0]) 1); 
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   499
by (asm_full_simp_tac 
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   500
    (simpset() addsimps [neg_eq_less_0, neg_nat, linorder_neq_iff]) 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   501
qed "nat_le_0"; 
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   502
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   503
Addsimps [nat_0_le, nat_le_0];
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   504
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   505
val [major,minor] = Goal "[| #0 <= z;  !!m. z = int m ==> P |] ==> P"; 
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   506
by (rtac (major RS nat_0_le RS sym RS minor) 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   507
qed "nonneg_eq_int"; 
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   508
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   509
Goal "#0 <= w ==> (nat w = m) = (w = int m)";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   510
by Auto_tac;
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   511
qed "nat_eq_iff";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   512
8796
4a3612f30865 if_weak_cong should make linear arithmetic faster
paulson
parents: 8787
diff changeset
   513
Goal "#0 <= w ==> (m = nat w) = (w = int m)";
4a3612f30865 if_weak_cong should make linear arithmetic faster
paulson
parents: 8787
diff changeset
   514
by Auto_tac;
4a3612f30865 if_weak_cong should make linear arithmetic faster
paulson
parents: 8787
diff changeset
   515
qed "nat_eq_iff2";
4a3612f30865 if_weak_cong should make linear arithmetic faster
paulson
parents: 8787
diff changeset
   516
7707
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   517
Goal "#0 <= w ==> (nat w < m) = (w < int m)";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   518
by (rtac iffI 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   519
by (asm_full_simp_tac 
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   520
    (simpset() delsimps [zless_int] addsimps [zless_int RS sym]) 2);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   521
by (etac (nat_0_le RS subst) 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   522
by (Simp_tac 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   523
qed "nat_less_iff";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   524
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   525
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   526
(*Users don't want to see (int 0), int(Suc 0) or w + - z*)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   527
Addsimps [int_0, int_Suc, symmetric zdiff_def];
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   528
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   529
Goal "nat #0 = 0";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   530
by (simp_tac (simpset() addsimps [nat_eq_iff]) 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   531
qed "nat_0";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   532
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   533
Goal "nat #1 = 1";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   534
by (simp_tac (simpset() addsimps [nat_eq_iff]) 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   535
qed "nat_1";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   536
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   537
Goal "nat #2 = 2";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   538
by (simp_tac (simpset() addsimps [nat_eq_iff]) 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   539
qed "nat_2";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   540
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   541
Goal "#0 <= w ==> (nat w < nat z) = (w<z)";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   542
by (case_tac "neg z" 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   543
by (auto_tac (claset(), simpset() addsimps [nat_less_iff]));
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   544
by (auto_tac (claset() addIs [zless_trans], 
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   545
	      simpset() addsimps [neg_eq_less_0, zle_def]));
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   546
qed "nat_less_eq_zless";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   547
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   548
Goal "#0 < w | #0 <= z ==> (nat w <= nat z) = (w<=z)";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   549
by (auto_tac (claset(), 
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   550
	      simpset() addsimps [linorder_not_less RS sym, 
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   551
				  zless_nat_conj]));
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   552
qed "nat_le_eq_zle";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   553
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   554
(*Analogous to zadd_int, but more easily provable using the arithmetic in Bin*)
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   555
Goal "n<=m --> int m - int n = int (m-n)";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   556
by (res_inst_tac [("m","m"),("n","n")] diff_induct 1);
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   557
by Auto_tac;
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   558
qed_spec_mp "zdiff_int";
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   559
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   560
9214
9454f30eacc7 Defined abs on int.
nipkow
parents: 9079
diff changeset
   561
(*** abs: absolute value, as an integer ****)
9454f30eacc7 Defined abs on int.
nipkow
parents: 9079
diff changeset
   562
9269
b62d5265b959 added zabs to arith_tac
nipkow
parents: 9214
diff changeset
   563
(* Simpler: use zabs_def as rewrite rule;
b62d5265b959 added zabs to arith_tac
nipkow
parents: 9214
diff changeset
   564
   but arith_tac is not parameterized by such simp rules
b62d5265b959 added zabs to arith_tac
nipkow
parents: 9214
diff changeset
   565
*)
b62d5265b959 added zabs to arith_tac
nipkow
parents: 9214
diff changeset
   566
Goalw [zabs_def]
b62d5265b959 added zabs to arith_tac
nipkow
parents: 9214
diff changeset
   567
 "P(abs(i::int)) = ((#0 <= i --> P i) & (i < #0 --> P(-i)))";
9214
9454f30eacc7 Defined abs on int.
nipkow
parents: 9079
diff changeset
   568
by(Simp_tac 1);
9269
b62d5265b959 added zabs to arith_tac
nipkow
parents: 9214
diff changeset
   569
qed "zabs_split";
b62d5265b959 added zabs to arith_tac
nipkow
parents: 9214
diff changeset
   570
b62d5265b959 added zabs to arith_tac
nipkow
parents: 9214
diff changeset
   571
arith_tac_split_thms := !arith_tac_split_thms @ [zabs_split];
b62d5265b959 added zabs to arith_tac
nipkow
parents: 9214
diff changeset
   572
b62d5265b959 added zabs to arith_tac
nipkow
parents: 9214
diff changeset
   573
Goal "abs(abs(x::int)) = abs(x)";
b62d5265b959 added zabs to arith_tac
nipkow
parents: 9214
diff changeset
   574
by(arith_tac 1);
9214
9454f30eacc7 Defined abs on int.
nipkow
parents: 9079
diff changeset
   575
qed "abs_abs";
9454f30eacc7 Defined abs on int.
nipkow
parents: 9079
diff changeset
   576
Addsimps [abs_abs];
9454f30eacc7 Defined abs on int.
nipkow
parents: 9079
diff changeset
   577
9269
b62d5265b959 added zabs to arith_tac
nipkow
parents: 9214
diff changeset
   578
Goal "abs(-(x::int)) = abs(x)";
b62d5265b959 added zabs to arith_tac
nipkow
parents: 9214
diff changeset
   579
by(arith_tac 1);
9214
9454f30eacc7 Defined abs on int.
nipkow
parents: 9079
diff changeset
   580
qed "abs_minus";
9454f30eacc7 Defined abs on int.
nipkow
parents: 9079
diff changeset
   581
Addsimps [abs_minus];
9454f30eacc7 Defined abs on int.
nipkow
parents: 9079
diff changeset
   582
9269
b62d5265b959 added zabs to arith_tac
nipkow
parents: 9214
diff changeset
   583
Goal "abs(x+y) <= abs(x) + abs(y::int)";
b62d5265b959 added zabs to arith_tac
nipkow
parents: 9214
diff changeset
   584
by(arith_tac 1);
b62d5265b959 added zabs to arith_tac
nipkow
parents: 9214
diff changeset
   585
qed "triangle_ineq";
b62d5265b959 added zabs to arith_tac
nipkow
parents: 9214
diff changeset
   586
9214
9454f30eacc7 Defined abs on int.
nipkow
parents: 9079
diff changeset
   587
9063
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   588
(*** Some convenient biconditionals for products of signs ***)
7707
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   589
9063
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   590
Goal "[| (#0::int) < i; #0 < j |] ==> #0 < i*j";
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   591
by (dtac zmult_zless_mono1 1);
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   592
by Auto_tac; 
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   593
qed "zmult_pos";
7707
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   594
9063
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   595
Goal "[| i < (#0::int); j < #0 |] ==> #0 < i*j";
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   596
by (dtac zmult_zless_mono1_neg 1);
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   597
by Auto_tac; 
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   598
qed "zmult_neg";
7707
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   599
9063
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   600
Goal "[| (#0::int) < i; j < #0 |] ==> i*j < #0";
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   601
by (dtac zmult_zless_mono1_neg 1);
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   602
by Auto_tac; 
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   603
qed "zmult_pos_neg";
7707
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   604
9063
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   605
Goal "((#0::int) < x*y) = (#0 < x & #0 < y | x < #0 & y < #0)";
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   606
by (auto_tac (claset(), 
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   607
              simpset() addsimps [order_le_less, linorder_not_less,
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   608
	                          zmult_pos, zmult_neg]));
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   609
by (ALLGOALS (rtac ccontr)); 
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   610
by (auto_tac (claset(), 
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   611
	      simpset() addsimps [order_le_less, linorder_not_less]));
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   612
by (ALLGOALS (etac rev_mp)); 
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   613
by (ALLGOALS (dtac zmult_pos_neg THEN' assume_tac));
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   614
by (auto_tac (claset() addDs [order_less_not_sym], 
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   615
              simpset() addsimps [zmult_commute]));  
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   616
qed "int_0_less_mult_iff";
7707
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   617
9063
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   618
Goal "((#0::int) <= x*y) = (#0 <= x & #0 <= y | x <= #0 & y <= #0)";
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   619
by (auto_tac (claset(), 
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   620
              simpset() addsimps [order_le_less, linorder_not_less,  
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   621
                                  int_0_less_mult_iff]));
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   622
qed "int_0_le_mult_iff";
7707
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   623
9063
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   624
Goal "(x*y < (#0::int)) = (#0 < x & y < #0 | x < #0 & #0 < y)";
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   625
by (auto_tac (claset(), 
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   626
              simpset() addsimps [int_0_le_mult_iff, 
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   627
                                  linorder_not_le RS sym]));
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   628
by (auto_tac (claset() addDs [order_less_not_sym],  
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   629
              simpset() addsimps [linorder_not_le]));
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   630
qed "zmult_less_0_iff";
7707
1f4b67fdfdae simprocs now in IntArith;
wenzelm
parents:
diff changeset
   631
9063
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   632
Goal "(x*y <= (#0::int)) = (#0 <= x & y <= #0 | x <= #0 & #0 <= y)";
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   633
by (auto_tac (claset() addDs [order_less_not_sym], 
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   634
              simpset() addsimps [int_0_less_mult_iff, 
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   635
                                  linorder_not_less RS sym]));
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   636
qed "zmult_le_0_iff";
0d7628966069 new lemmas for signs of products
paulson
parents: 9000
diff changeset
   637