| author | wenzelm | 
| Wed, 07 Nov 2001 18:18:29 +0100 | |
| changeset 12094 | db9a3ad6e90e | 
| parent 11868 | 56db9f3a6b3e | 
| child 12196 | a3be6b3a9c0b | 
| permissions | -rw-r--r-- | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
1  | 
(* Title: HOL/nat_simprocs.ML  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
2  | 
ID: $Id$  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
3  | 
Author: Lawrence C Paulson, Cambridge University Computer Laboratory  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
4  | 
Copyright 2000 University of Cambridge  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
5  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
6  | 
Simprocs for nat numerals.  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
7  | 
*)  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
8  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
9  | 
Goal "number_of v + (number_of v' + (k::nat)) = \  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
10  | 
\ (if neg (number_of v) then number_of v' + k \  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
11  | 
\ else if neg (number_of v') then number_of v + k \  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
12  | 
\ else number_of (bin_add v v') + k)";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
13  | 
by (Simp_tac 1);  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
14  | 
qed "nat_number_of_add_left";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
15  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
16  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
17  | 
(** For combine_numerals **)  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
18  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
19  | 
Goal "i*u + (j*u + k) = (i+j)*u + (k::nat)";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
20  | 
by (asm_simp_tac (simpset() addsimps [add_mult_distrib]) 1);  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
21  | 
qed "left_add_mult_distrib";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
22  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
23  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
24  | 
(** For cancel_numerals **)  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
25  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
26  | 
Goal "j <= (i::nat) ==> ((i*u + m) - (j*u + n)) = (((i-j)*u + m) - n)";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
27  | 
by (asm_simp_tac (simpset() addsplits [nat_diff_split]  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
28  | 
addsimps [add_mult_distrib]) 1);  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
29  | 
qed "nat_diff_add_eq1";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
30  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
31  | 
Goal "i <= (j::nat) ==> ((i*u + m) - (j*u + n)) = (m - ((j-i)*u + n))";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
32  | 
by (asm_simp_tac (simpset() addsplits [nat_diff_split]  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
33  | 
addsimps [add_mult_distrib]) 1);  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
34  | 
qed "nat_diff_add_eq2";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
35  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
36  | 
Goal "j <= (i::nat) ==> (i*u + m = j*u + n) = ((i-j)*u + m = n)";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
37  | 
by (auto_tac (claset(), simpset() addsplits [nat_diff_split]  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
38  | 
addsimps [add_mult_distrib]));  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
39  | 
qed "nat_eq_add_iff1";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
40  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
41  | 
Goal "i <= (j::nat) ==> (i*u + m = j*u + n) = (m = (j-i)*u + n)";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
42  | 
by (auto_tac (claset(), simpset() addsplits [nat_diff_split]  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
43  | 
addsimps [add_mult_distrib]));  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
44  | 
qed "nat_eq_add_iff2";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
45  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
46  | 
Goal "j <= (i::nat) ==> (i*u + m < j*u + n) = ((i-j)*u + m < n)";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
47  | 
by (auto_tac (claset(), simpset() addsplits [nat_diff_split]  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
48  | 
addsimps [add_mult_distrib]));  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
49  | 
qed "nat_less_add_iff1";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
50  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
51  | 
Goal "i <= (j::nat) ==> (i*u + m < j*u + n) = (m < (j-i)*u + n)";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
52  | 
by (auto_tac (claset(), simpset() addsplits [nat_diff_split]  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
53  | 
addsimps [add_mult_distrib]));  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
54  | 
qed "nat_less_add_iff2";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
55  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
56  | 
Goal "j <= (i::nat) ==> (i*u + m <= j*u + n) = ((i-j)*u + m <= n)";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
57  | 
by (auto_tac (claset(), simpset() addsplits [nat_diff_split]  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
58  | 
addsimps [add_mult_distrib]));  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
59  | 
qed "nat_le_add_iff1";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
60  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
61  | 
Goal "i <= (j::nat) ==> (i*u + m <= j*u + n) = (m <= (j-i)*u + n)";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
62  | 
by (auto_tac (claset(), simpset() addsplits [nat_diff_split]  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
63  | 
addsimps [add_mult_distrib]));  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
64  | 
qed "nat_le_add_iff2";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
65  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
66  | 
|
| 10536 | 67  | 
(** For cancel_numeral_factors **)  | 
68  | 
||
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
69  | 
Goal "(0::nat) < k ==> (k*m <= k*n) = (m<=n)";  | 
| 10536 | 70  | 
by Auto_tac;  | 
71  | 
qed "nat_mult_le_cancel1";  | 
|
72  | 
||
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
73  | 
Goal "(0::nat) < k ==> (k*m < k*n) = (m<n)";  | 
| 10536 | 74  | 
by Auto_tac;  | 
75  | 
qed "nat_mult_less_cancel1";  | 
|
76  | 
||
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
77  | 
Goal "(0::nat) < k ==> (k*m = k*n) = (m=n)";  | 
| 10536 | 78  | 
by Auto_tac;  | 
79  | 
qed "nat_mult_eq_cancel1";  | 
|
80  | 
||
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
81  | 
Goal "(0::nat) < k ==> (k*m) div (k*n) = (m div n)";  | 
| 10536 | 82  | 
by Auto_tac;  | 
83  | 
qed "nat_mult_div_cancel1";  | 
|
84  | 
||
85  | 
||
| 10704 | 86  | 
(** For cancel_factor **)  | 
87  | 
||
88  | 
Goal "(k*m <= k*n) = ((0::nat) < k --> m<=n)";  | 
|
89  | 
by Auto_tac;  | 
|
90  | 
qed "nat_mult_le_cancel_disj";  | 
|
91  | 
||
92  | 
Goal "(k*m < k*n) = ((0::nat) < k & m<n)";  | 
|
93  | 
by Auto_tac;  | 
|
94  | 
qed "nat_mult_less_cancel_disj";  | 
|
95  | 
||
96  | 
Goal "(k*m = k*n) = (k = (0::nat) | m=n)";  | 
|
97  | 
by Auto_tac;  | 
|
98  | 
qed "nat_mult_eq_cancel_disj";  | 
|
99  | 
||
100  | 
Goal "(k*m) div (k*n) = (if k = (0::nat) then 0 else m div n)";  | 
|
101  | 
by (simp_tac (simpset() addsimps [nat_mult_div_cancel1]) 1);  | 
|
102  | 
qed "nat_mult_div_cancel_disj";  | 
|
103  | 
||
104  | 
||
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
105  | 
structure Nat_Numeral_Simprocs =  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
106  | 
struct  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
107  | 
|
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
108  | 
(*Maps n to #n for n = 0, 1, 2*)  | 
| 
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
109  | 
val numeral_syms =  | 
| 
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
110  | 
[numeral_0_eq_0 RS sym, numeral_1_eq_1 RS sym, numeral_2_eq_2 RS sym];  | 
| 
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
111  | 
val numeral_sym_ss = HOL_ss addsimps numeral_syms;  | 
| 
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
112  | 
|
| 
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
113  | 
fun rename_numerals th =  | 
| 
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
114  | 
simplify numeral_sym_ss (Thm.transfer (the_context ()) th);  | 
| 
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
115  | 
|
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
116  | 
(*Utilities*)  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
117  | 
|
| 10693 | 118  | 
fun mk_numeral n = HOLogic.number_of_const HOLogic.natT $ HOLogic.mk_bin n;  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
119  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
120  | 
(*Decodes a unary or binary numeral to a NATURAL NUMBER*)  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
121  | 
fun dest_numeral (Const ("0", _)) = 0
 | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
122  | 
  | dest_numeral (Const ("Suc", _) $ t) = 1 + dest_numeral t
 | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
123  | 
  | dest_numeral (Const("Numeral.number_of", _) $ w) =
 | 
| 10890 | 124  | 
(BasisLibrary.Int.max (0, HOLogic.dest_binum w)  | 
125  | 
       handle TERM _ => raise TERM("Nat_Numeral_Simprocs.dest_numeral:1", [w]))
 | 
|
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
126  | 
  | dest_numeral t = raise TERM("Nat_Numeral_Simprocs.dest_numeral:2", [t]);
 | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
127  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
128  | 
fun find_first_numeral past (t::terms) =  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
129  | 
((dest_numeral t, t, rev past @ terms)  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
130  | 
handle TERM _ => find_first_numeral (t::past) terms)  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
131  | 
  | find_first_numeral past [] = raise TERM("find_first_numeral", []);
 | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
132  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
133  | 
val zero = mk_numeral 0;  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
134  | 
val mk_plus = HOLogic.mk_binop "op +";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
135  | 
|
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
136  | 
(*Thus mk_sum[t] yields t+0; longer sums don't have a trailing zero*)  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
137  | 
fun mk_sum [] = zero  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
138  | 
| mk_sum [t,u] = mk_plus (t, u)  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
139  | 
| mk_sum (t :: ts) = mk_plus (t, mk_sum ts);  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
140  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
141  | 
(*this version ALWAYS includes a trailing zero*)  | 
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
142  | 
fun long_mk_sum [] = HOLogic.zero  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
143  | 
| long_mk_sum (t :: ts) = mk_plus (t, mk_sum ts);  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
144  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
145  | 
val dest_plus = HOLogic.dest_bin "op +" HOLogic.natT;  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
146  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
147  | 
(*extract the outer Sucs from a term and convert them to a binary numeral*)  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
148  | 
fun dest_Sucs (k, Const ("Suc", _) $ t) = dest_Sucs (k+1, t)
 | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
149  | 
| dest_Sucs (0, t) = t  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
150  | 
| dest_Sucs (k, t) = mk_plus (mk_numeral k, t);  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
151  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
152  | 
fun dest_sum t =  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
153  | 
let val (t,u) = dest_plus t  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
154  | 
in dest_sum t @ dest_sum u end  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
155  | 
handle TERM _ => [t];  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
156  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
157  | 
fun dest_Sucs_sum t = dest_sum (dest_Sucs (0,t));  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
158  | 
|
| 
11377
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
159  | 
|
| 
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
160  | 
(** Other simproc items **)  | 
| 
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
161  | 
|
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
162  | 
val trans_tac = Int_Numeral_Simprocs.trans_tac;  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
163  | 
|
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
164  | 
val bin_simps = [numeral_0_eq_0 RS sym, numeral_1_eq_1 RS sym,  | 
| 
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
165  | 
add_nat_number_of, nat_number_of_add_left,  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
166  | 
diff_nat_number_of, le_nat_number_of_eq_not_less,  | 
| 10536 | 167  | 
less_nat_number_of, mult_nat_number_of,  | 
| 
11701
 
3d51fbf81c17
sane numerals (stage 1): added generic 1, removed 1' and 2 on nat,
 
wenzelm 
parents: 
11377 
diff
changeset
 | 
168  | 
thm "Let_number_of", nat_number_of] @  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
169  | 
bin_arith_simps @ bin_rel_simps;  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
170  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
171  | 
fun prep_simproc (name, pats, proc) = Simplifier.mk_simproc name pats proc;  | 
| 
11377
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
172  | 
fun prep_pat s = Thm.read_cterm (Theory.sign_of (the_context ()))  | 
| 
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
173  | 
(s, HOLogic.termT);  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
174  | 
val prep_pats = map prep_pat;  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
175  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
176  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
177  | 
(*** CancelNumerals simprocs ***)  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
178  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
179  | 
val one = mk_numeral 1;  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
180  | 
val mk_times = HOLogic.mk_binop "op *";  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
181  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
182  | 
fun mk_prod [] = one  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
183  | 
| mk_prod [t] = t  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
184  | 
| mk_prod (t :: ts) = if t = one then mk_prod ts  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
185  | 
else mk_times (t, mk_prod ts);  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
186  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
187  | 
val dest_times = HOLogic.dest_bin "op *" HOLogic.natT;  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
188  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
189  | 
fun dest_prod t =  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
190  | 
let val (t,u) = dest_times t  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
191  | 
in dest_prod t @ dest_prod u end  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
192  | 
handle TERM _ => [t];  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
193  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
194  | 
(*DON'T do the obvious simplifications; that would create special cases*)  | 
| 
9544
 
f9202e219a29
added a dummy "thm list" argument to prove_conv for the new interface to
 
paulson 
parents: 
9436 
diff
changeset
 | 
195  | 
fun mk_coeff (k,t) = mk_times (mk_numeral k, t);  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
196  | 
|
| 
9544
 
f9202e219a29
added a dummy "thm list" argument to prove_conv for the new interface to
 
paulson 
parents: 
9436 
diff
changeset
 | 
197  | 
(*Express t as a product of (possibly) a numeral with other factors, sorted*)  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
198  | 
fun dest_coeff t =  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
199  | 
let val ts = sort Term.term_ord (dest_prod t)  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
200  | 
val (n, _, ts') = find_first_numeral [] ts  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
201  | 
handle TERM _ => (1, one, ts)  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
202  | 
in (n, mk_prod ts') end;  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
203  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
204  | 
(*Find first coefficient-term THAT MATCHES u*)  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
205  | 
fun find_first_coeff past u [] = raise TERM("find_first_coeff", [])
 | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
206  | 
| find_first_coeff past u (t::terms) =  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
207  | 
let val (n,u') = dest_coeff t  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
208  | 
in if u aconv u' then (n, rev past @ terms)  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
209  | 
else find_first_coeff (t::past) u terms  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
210  | 
end  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
211  | 
handle TERM _ => find_first_coeff (t::past) u terms;  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
212  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
213  | 
|
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
214  | 
(*Simplify 1*n and n*1 to n*)  | 
| 
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
215  | 
val add_0s = map rename_numerals [add_0, add_0_right];  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
216  | 
val mult_1s = map rename_numerals [mult_1, mult_1_right];  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
217  | 
|
| 
11701
 
3d51fbf81c17
sane numerals (stage 1): added generic 1, removed 1' and 2 on nat,
 
wenzelm 
parents: 
11377 
diff
changeset
 | 
218  | 
(*Final simplification: cancel + and *; replace Numeral0 by 0 and Numeral1 by 1*)  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
219  | 
val simplify_meta_eq =  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
220  | 
Int_Numeral_Simprocs.simplify_meta_eq  | 
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
221  | 
[numeral_0_eq_0, numeral_1_eq_Suc_0, add_0, add_0_right,  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
222  | 
mult_0, mult_0_right, mult_1, mult_1_right];  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
223  | 
|
| 10536 | 224  | 
|
| 
11377
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
225  | 
(** Restricted version of dest_Sucs_sum for nat_combine_numerals:  | 
| 
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
226  | 
Simprocs never apply unless the original expression contains at least one  | 
| 
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
227  | 
numeral in a coefficient position.  | 
| 
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
228  | 
**)  | 
| 
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
229  | 
|
| 
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
230  | 
fun is_numeral (Const("Numeral.number_of", _) $ w) = true
 | 
| 
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
231  | 
| is_numeral _ = false;  | 
| 
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
232  | 
|
| 
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
233  | 
fun prod_has_numeral t = exists is_numeral (dest_prod t);  | 
| 
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
234  | 
|
| 
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
235  | 
fun restricted_dest_Sucs_sum t =  | 
| 
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
236  | 
let val ts = dest_Sucs_sum t  | 
| 
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
237  | 
in if exists prod_has_numeral ts then ts  | 
| 
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
238  | 
      else raise TERM("Nat_Numeral_Simprocs.restricted_dest_Sucs_sum", ts)
 | 
| 
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
239  | 
end;  | 
| 
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
240  | 
|
| 
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
241  | 
|
| 10704 | 242  | 
(*** Applying CancelNumeralsFun ***)  | 
| 10536 | 243  | 
|
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
244  | 
structure CancelNumeralsCommon =  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
245  | 
struct  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
246  | 
val mk_sum = mk_sum  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
247  | 
val dest_sum = dest_Sucs_sum  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
248  | 
val mk_coeff = mk_coeff  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
249  | 
val dest_coeff = dest_coeff  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
250  | 
val find_first_coeff = find_first_coeff []  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
251  | 
val trans_tac = trans_tac  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
252  | 
val norm_tac = ALLGOALS  | 
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
253  | 
(simp_tac (HOL_ss addsimps numeral_syms@add_0s@mult_1s@  | 
| 
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
254  | 
[Suc_eq_add_numeral_1] @ add_ac))  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
255  | 
THEN ALLGOALS (simp_tac  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
256  | 
(HOL_ss addsimps bin_simps@add_ac@mult_ac))  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
257  | 
val numeral_simp_tac = ALLGOALS  | 
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
258  | 
(simp_tac (HOL_ss addsimps add_0s@bin_simps))  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
259  | 
val simplify_meta_eq = simplify_meta_eq  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
260  | 
end;  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
261  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
262  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
263  | 
structure EqCancelNumerals = CancelNumeralsFun  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
264  | 
(open CancelNumeralsCommon  | 
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
265  | 
val prove_conv = Bin_Simprocs.prove_conv "nateq_cancel_numerals"  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
266  | 
val mk_bal = HOLogic.mk_eq  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
267  | 
val dest_bal = HOLogic.dest_bin "op =" HOLogic.natT  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
268  | 
val bal_add1 = nat_eq_add_iff1 RS trans  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
269  | 
val bal_add2 = nat_eq_add_iff2 RS trans  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
270  | 
);  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
271  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
272  | 
structure LessCancelNumerals = CancelNumeralsFun  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
273  | 
(open CancelNumeralsCommon  | 
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
274  | 
val prove_conv = Bin_Simprocs.prove_conv "natless_cancel_numerals"  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
275  | 
val mk_bal = HOLogic.mk_binrel "op <"  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
276  | 
val dest_bal = HOLogic.dest_bin "op <" HOLogic.natT  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
277  | 
val bal_add1 = nat_less_add_iff1 RS trans  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
278  | 
val bal_add2 = nat_less_add_iff2 RS trans  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
279  | 
);  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
280  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
281  | 
structure LeCancelNumerals = CancelNumeralsFun  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
282  | 
(open CancelNumeralsCommon  | 
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
283  | 
val prove_conv = Bin_Simprocs.prove_conv "natle_cancel_numerals"  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
284  | 
val mk_bal = HOLogic.mk_binrel "op <="  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
285  | 
val dest_bal = HOLogic.dest_bin "op <=" HOLogic.natT  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
286  | 
val bal_add1 = nat_le_add_iff1 RS trans  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
287  | 
val bal_add2 = nat_le_add_iff2 RS trans  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
288  | 
);  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
289  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
290  | 
structure DiffCancelNumerals = CancelNumeralsFun  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
291  | 
(open CancelNumeralsCommon  | 
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
292  | 
val prove_conv = Bin_Simprocs.prove_conv "natdiff_cancel_numerals"  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
293  | 
val mk_bal = HOLogic.mk_binop "op -"  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
294  | 
val dest_bal = HOLogic.dest_bin "op -" HOLogic.natT  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
295  | 
val bal_add1 = nat_diff_add_eq1 RS trans  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
296  | 
val bal_add2 = nat_diff_add_eq2 RS trans  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
297  | 
);  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
298  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
299  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
300  | 
val cancel_numerals =  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
301  | 
map prep_simproc  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
302  | 
   [("nateq_cancel_numerals",
 | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
303  | 
prep_pats ["(l::nat) + m = n", "(l::nat) = m + n",  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
304  | 
"(l::nat) * m = n", "(l::nat) = m * n",  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
305  | 
"Suc m = n", "m = Suc n"],  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
306  | 
EqCancelNumerals.proc),  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
307  | 
    ("natless_cancel_numerals",
 | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
308  | 
prep_pats ["(l::nat) + m < n", "(l::nat) < m + n",  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
309  | 
"(l::nat) * m < n", "(l::nat) < m * n",  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
310  | 
"Suc m < n", "m < Suc n"],  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
311  | 
LessCancelNumerals.proc),  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
312  | 
    ("natle_cancel_numerals",
 | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
313  | 
prep_pats ["(l::nat) + m <= n", "(l::nat) <= m + n",  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
314  | 
"(l::nat) * m <= n", "(l::nat) <= m * n",  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
315  | 
"Suc m <= n", "m <= Suc n"],  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
316  | 
LeCancelNumerals.proc),  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
317  | 
    ("natdiff_cancel_numerals",
 | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
318  | 
prep_pats ["((l::nat) + m) - n", "(l::nat) - (m + n)",  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
319  | 
"(l::nat) * m - n", "(l::nat) - m * n",  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
320  | 
"Suc m - n", "m - Suc n"],  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
321  | 
DiffCancelNumerals.proc)];  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
322  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
323  | 
|
| 10704 | 324  | 
(*** Applying CombineNumeralsFun ***)  | 
| 10536 | 325  | 
|
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
326  | 
structure CombineNumeralsData =  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
327  | 
struct  | 
| 9571 | 328  | 
val add = op + : int*int -> int  | 
| 
11704
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
329  | 
val mk_sum = long_mk_sum (*to work for e.g. 2*x + 3*x *)  | 
| 
11377
 
0f16ad464c62
Simprocs for type "nat" no longer introduce numerals unless they are already
 
paulson 
parents: 
11334 
diff
changeset
 | 
330  | 
val dest_sum = restricted_dest_Sucs_sum  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
331  | 
val mk_coeff = mk_coeff  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
332  | 
val dest_coeff = dest_coeff  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
333  | 
val left_distrib = left_add_mult_distrib RS trans  | 
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
334  | 
val prove_conv = Bin_Simprocs.prove_conv_nohyps "nat_combine_numerals"  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
335  | 
val trans_tac = trans_tac  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
336  | 
val norm_tac = ALLGOALS  | 
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
337  | 
(simp_tac (HOL_ss addsimps numeral_syms@add_0s@mult_1s@  | 
| 
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
338  | 
[Suc_eq_add_numeral_1] @ add_ac))  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
339  | 
THEN ALLGOALS (simp_tac  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
340  | 
(HOL_ss addsimps bin_simps@add_ac@mult_ac))  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
341  | 
val numeral_simp_tac = ALLGOALS  | 
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
342  | 
(simp_tac (HOL_ss addsimps add_0s@bin_simps))  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
343  | 
val simplify_meta_eq = simplify_meta_eq  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
344  | 
end;  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
345  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
346  | 
structure CombineNumerals = CombineNumeralsFun(CombineNumeralsData);  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
347  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
348  | 
val combine_numerals =  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
349  | 
    prep_simproc ("nat_combine_numerals",
 | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
350  | 
prep_pats ["(i::nat) + j", "Suc (i + j)"],  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
351  | 
CombineNumerals.proc);  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
352  | 
|
| 10536 | 353  | 
|
| 10704 | 354  | 
(*** Applying CancelNumeralFactorFun ***)  | 
| 10536 | 355  | 
|
356  | 
structure CancelNumeralFactorCommon =  | 
|
357  | 
struct  | 
|
358  | 
val mk_coeff = mk_coeff  | 
|
359  | 
val dest_coeff = dest_coeff  | 
|
360  | 
val trans_tac = trans_tac  | 
|
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
361  | 
val norm_tac = ALLGOALS  | 
| 
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
362  | 
(simp_tac (HOL_ss addsimps [Suc_eq_add_numeral_1]@mult_1s))  | 
| 10536 | 363  | 
THEN ALLGOALS (simp_tac (HOL_ss addsimps bin_simps@mult_ac))  | 
364  | 
val numeral_simp_tac = ALLGOALS (simp_tac (HOL_ss addsimps bin_simps))  | 
|
365  | 
val simplify_meta_eq = simplify_meta_eq  | 
|
366  | 
end  | 
|
367  | 
||
368  | 
structure DivCancelNumeralFactor = CancelNumeralFactorFun  | 
|
369  | 
(open CancelNumeralFactorCommon  | 
|
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
370  | 
val prove_conv = Bin_Simprocs.prove_conv "natdiv_cancel_numeral_factor"  | 
| 10536 | 371  | 
val mk_bal = HOLogic.mk_binop "Divides.op div"  | 
372  | 
val dest_bal = HOLogic.dest_bin "Divides.op div" HOLogic.natT  | 
|
373  | 
val cancel = nat_mult_div_cancel1 RS trans  | 
|
374  | 
val neg_exchanges = false  | 
|
375  | 
)  | 
|
376  | 
||
377  | 
structure EqCancelNumeralFactor = CancelNumeralFactorFun  | 
|
378  | 
(open CancelNumeralFactorCommon  | 
|
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
379  | 
val prove_conv = Bin_Simprocs.prove_conv "nateq_cancel_numeral_factor"  | 
| 10536 | 380  | 
val mk_bal = HOLogic.mk_eq  | 
381  | 
val dest_bal = HOLogic.dest_bin "op =" HOLogic.natT  | 
|
382  | 
val cancel = nat_mult_eq_cancel1 RS trans  | 
|
383  | 
val neg_exchanges = false  | 
|
384  | 
)  | 
|
385  | 
||
386  | 
structure LessCancelNumeralFactor = CancelNumeralFactorFun  | 
|
387  | 
(open CancelNumeralFactorCommon  | 
|
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
388  | 
val prove_conv = Bin_Simprocs.prove_conv "natless_cancel_numeral_factor"  | 
| 10536 | 389  | 
val mk_bal = HOLogic.mk_binrel "op <"  | 
390  | 
val dest_bal = HOLogic.dest_bin "op <" HOLogic.natT  | 
|
391  | 
val cancel = nat_mult_less_cancel1 RS trans  | 
|
392  | 
val neg_exchanges = true  | 
|
393  | 
)  | 
|
394  | 
||
395  | 
structure LeCancelNumeralFactor = CancelNumeralFactorFun  | 
|
396  | 
(open CancelNumeralFactorCommon  | 
|
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
397  | 
val prove_conv = Bin_Simprocs.prove_conv "natle_cancel_numeral_factor"  | 
| 10536 | 398  | 
val mk_bal = HOLogic.mk_binrel "op <="  | 
399  | 
val dest_bal = HOLogic.dest_bin "op <=" HOLogic.natT  | 
|
400  | 
val cancel = nat_mult_le_cancel1 RS trans  | 
|
401  | 
val neg_exchanges = true  | 
|
402  | 
)  | 
|
403  | 
||
404  | 
val cancel_numeral_factors =  | 
|
405  | 
map prep_simproc  | 
|
406  | 
   [("nateq_cancel_numeral_factors",
 | 
|
407  | 
prep_pats ["(l::nat) * m = n", "(l::nat) = m * n"],  | 
|
408  | 
EqCancelNumeralFactor.proc),  | 
|
409  | 
    ("natless_cancel_numeral_factors", 
 | 
|
410  | 
prep_pats ["(l::nat) * m < n", "(l::nat) < m * n"],  | 
|
411  | 
LessCancelNumeralFactor.proc),  | 
|
412  | 
    ("natle_cancel_numeral_factors", 
 | 
|
413  | 
prep_pats ["(l::nat) * m <= n", "(l::nat) <= m * n"],  | 
|
414  | 
LeCancelNumeralFactor.proc),  | 
|
415  | 
    ("natdiv_cancel_numeral_factors", 
 | 
|
416  | 
prep_pats ["((l::nat) * m) div n", "(l::nat) div (m * n)"],  | 
|
417  | 
DivCancelNumeralFactor.proc)];  | 
|
418  | 
||
| 10704 | 419  | 
|
420  | 
||
421  | 
(*** Applying ExtractCommonTermFun ***)  | 
|
422  | 
||
423  | 
(*this version ALWAYS includes a trailing one*)  | 
|
424  | 
fun long_mk_prod [] = one  | 
|
425  | 
| long_mk_prod (t :: ts) = mk_times (t, mk_prod ts);  | 
|
426  | 
||
427  | 
(*Find first term that matches u*)  | 
|
428  | 
fun find_first past u []         = raise TERM("find_first", []) 
 | 
|
429  | 
| find_first past u (t::terms) =  | 
|
430  | 
if u aconv t then (rev past @ terms)  | 
|
431  | 
else find_first (t::past) u terms  | 
|
432  | 
handle TERM _ => find_first (t::past) u terms;  | 
|
433  | 
||
434  | 
(*Final simplification: cancel + and * *)  | 
|
435  | 
fun cancel_simplify_meta_eq cancel_th th =  | 
|
436  | 
Int_Numeral_Simprocs.simplify_meta_eq [zmult_1, zmult_1_right]  | 
|
437  | 
(([th, cancel_th]) MRS trans);  | 
|
438  | 
||
439  | 
structure CancelFactorCommon =  | 
|
440  | 
struct  | 
|
441  | 
val mk_sum = long_mk_prod  | 
|
442  | 
val dest_sum = dest_prod  | 
|
443  | 
val mk_coeff = mk_coeff  | 
|
444  | 
val dest_coeff = dest_coeff  | 
|
445  | 
val find_first = find_first []  | 
|
446  | 
val trans_tac = trans_tac  | 
|
447  | 
val norm_tac = ALLGOALS (simp_tac (HOL_ss addsimps mult_1s@mult_ac))  | 
|
448  | 
end;  | 
|
449  | 
||
450  | 
structure EqCancelFactor = ExtractCommonTermFun  | 
|
451  | 
(open CancelFactorCommon  | 
|
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
452  | 
val prove_conv = Bin_Simprocs.prove_conv "nat_eq_cancel_factor"  | 
| 10704 | 453  | 
val mk_bal = HOLogic.mk_eq  | 
454  | 
val dest_bal = HOLogic.dest_bin "op =" HOLogic.natT  | 
|
455  | 
val simplify_meta_eq = cancel_simplify_meta_eq nat_mult_eq_cancel_disj  | 
|
456  | 
);  | 
|
457  | 
||
458  | 
structure LessCancelFactor = ExtractCommonTermFun  | 
|
459  | 
(open CancelFactorCommon  | 
|
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
460  | 
val prove_conv = Bin_Simprocs.prove_conv "nat_less_cancel_factor"  | 
| 10704 | 461  | 
val mk_bal = HOLogic.mk_binrel "op <"  | 
462  | 
val dest_bal = HOLogic.dest_bin "op <" HOLogic.natT  | 
|
463  | 
val simplify_meta_eq = cancel_simplify_meta_eq nat_mult_less_cancel_disj  | 
|
464  | 
);  | 
|
465  | 
||
466  | 
structure LeCancelFactor = ExtractCommonTermFun  | 
|
467  | 
(open CancelFactorCommon  | 
|
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
468  | 
val prove_conv = Bin_Simprocs.prove_conv "nat_leq_cancel_factor"  | 
| 10704 | 469  | 
val mk_bal = HOLogic.mk_binrel "op <="  | 
470  | 
val dest_bal = HOLogic.dest_bin "op <=" HOLogic.natT  | 
|
471  | 
val simplify_meta_eq = cancel_simplify_meta_eq nat_mult_le_cancel_disj  | 
|
472  | 
);  | 
|
473  | 
||
474  | 
structure DivideCancelFactor = ExtractCommonTermFun  | 
|
475  | 
(open CancelFactorCommon  | 
|
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
476  | 
val prove_conv = Bin_Simprocs.prove_conv "nat_divide_cancel_factor"  | 
| 10704 | 477  | 
val mk_bal = HOLogic.mk_binop "Divides.op div"  | 
478  | 
val dest_bal = HOLogic.dest_bin "Divides.op div" HOLogic.natT  | 
|
479  | 
val simplify_meta_eq = cancel_simplify_meta_eq nat_mult_div_cancel_disj  | 
|
480  | 
);  | 
|
481  | 
||
482  | 
val cancel_factor =  | 
|
483  | 
map prep_simproc  | 
|
484  | 
   [("nat_eq_cancel_factor",
 | 
|
485  | 
prep_pats ["(l::nat) * m = n", "(l::nat) = m * n"],  | 
|
486  | 
EqCancelFactor.proc),  | 
|
487  | 
    ("nat_less_cancel_factor",
 | 
|
488  | 
prep_pats ["(l::nat) * m < n", "(l::nat) < m * n"],  | 
|
489  | 
LessCancelFactor.proc),  | 
|
490  | 
    ("nat_le_cancel_factor",
 | 
|
491  | 
prep_pats ["(l::nat) * m <= n", "(l::nat) <= m * n"],  | 
|
492  | 
LeCancelFactor.proc),  | 
|
493  | 
    ("nat_divide_cancel_factor", 
 | 
|
494  | 
prep_pats ["((l::nat) * m) div n", "(l::nat) div (m * n)"],  | 
|
495  | 
DivideCancelFactor.proc)];  | 
|
496  | 
||
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
497  | 
end;  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
498  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
499  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
500  | 
Addsimprocs Nat_Numeral_Simprocs.cancel_numerals;  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
501  | 
Addsimprocs [Nat_Numeral_Simprocs.combine_numerals];  | 
| 10536 | 502  | 
Addsimprocs Nat_Numeral_Simprocs.cancel_numeral_factors;  | 
| 10704 | 503  | 
Addsimprocs Nat_Numeral_Simprocs.cancel_factor;  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
504  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
505  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
506  | 
(*examples:  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
507  | 
print_depth 22;  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
508  | 
set timing;  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
509  | 
set trace_simp;  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
510  | 
fun test s = (Goal s; by (Simp_tac 1));  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
511  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
512  | 
(*cancel_numerals*)  | 
| 
11704
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
513  | 
test "l +( 2) + (2) + 2 + (l + 2) + (oo + 2) = (uu::nat)";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
514  | 
test "(2*length xs < 2*length xs + j)";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
515  | 
test "(2*length xs < length xs * 2 + j)";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
516  | 
test "2*u = (u::nat)";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
517  | 
test "2*u = Suc (u)";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
518  | 
test "(i + j + 12 + (k::nat)) - 15 = y";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
519  | 
test "(i + j + 12 + (k::nat)) - 5 = y";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
520  | 
test "Suc u - 2 = y";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
521  | 
test "Suc (Suc (Suc u)) - 2 = y";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
522  | 
test "(i + j + 2 + (k::nat)) - 1 = y";  | 
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
523  | 
test "(i + j + 1 + (k::nat)) - 2 = y";  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
524  | 
|
| 
11704
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
525  | 
test "(2*x + (u*v) + y) - v*3*u = (w::nat)";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
526  | 
test "(2*x*u*v + 5 + (u*v)*4 + y) - v*u*4 = (w::nat)";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
527  | 
test "(2*x*u*v + (u*v)*4 + y) - v*u = (w::nat)";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
528  | 
test "Suc (Suc (2*x*u*v + u*4 + y)) - u = w";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
529  | 
test "Suc ((u*v)*4) - v*3*u = w";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
530  | 
test "Suc (Suc ((u*v)*3)) - v*3*u = w";  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
531  | 
|
| 
11704
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
532  | 
test "(i + j + 12 + (k::nat)) = u + 15 + y";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
533  | 
test "(i + j + 32 + (k::nat)) - (u + 15 + y) = zz";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
534  | 
test "(i + j + 12 + (k::nat)) = u + 5 + y";  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
535  | 
(*Suc*)  | 
| 
11704
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
536  | 
test "(i + j + 12 + k) = Suc (u + y)";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
537  | 
test "Suc (Suc (Suc (Suc (Suc (u + y))))) <= ((i + j) + 41 + k)";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
538  | 
test "(i + j + 5 + k) < Suc (Suc (Suc (Suc (Suc (u + y)))))";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
539  | 
test "Suc (Suc (Suc (Suc (Suc (u + y))))) - 5 = v";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
540  | 
test "(i + j + 5 + k) = Suc (Suc (Suc (Suc (Suc (Suc (Suc (u + y)))))))";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
541  | 
test "2*y + 3*z + 2*u = Suc (u)";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
542  | 
test "2*y + 3*z + 6*w + 2*y + 3*z + 2*u = Suc (u)";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
543  | 
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::nat)";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
544  | 
test "6 + 2*y + 3*z + 4*u = Suc (vv + 2*u + z)";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
545  | 
test "(2*n*m) < (3*(m*n)) + (u::nat)";  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
546  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
547  | 
(*negative numerals: FAIL*)  | 
| 
11704
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
548  | 
test "(i + j + -23 + (k::nat)) < u + 15 + y";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
549  | 
test "(i + j + 3 + (k::nat)) < u + -15 + y";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
550  | 
test "(i + j + -12 + (k::nat)) - 15 = y";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
551  | 
test "(i + j + 12 + (k::nat)) - -15 = y";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
552  | 
test "(i + j + -12 + (k::nat)) - -15 = y";  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
553  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
554  | 
(*combine_numerals*)  | 
| 
11704
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
555  | 
test "k + 3*k = (u::nat)";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
556  | 
test "Suc (i + 3) = u";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
557  | 
test "Suc (i + j + 3 + k) = u";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
558  | 
test "k + j + 3*k + j = (u::nat)";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
559  | 
test "Suc (j*i + i + k + 5 + 3*k + i*j*4) = (u::nat)";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
560  | 
test "(2*n*m) + (3*(m*n)) = (u::nat)";  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
561  | 
(*negative numerals: FAIL*)  | 
| 
11704
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
562  | 
test "Suc (i + j + -3 + k) = u";  | 
| 10536 | 563  | 
|
| 10704 | 564  | 
(*cancel_numeral_factors*)  | 
| 
11704
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
565  | 
test "9*x = 12 * (y::nat)";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
566  | 
test "(9*x) div (12 * (y::nat)) = z";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
567  | 
test "9*x < 12 * (y::nat)";  | 
| 
 
3c50a2cd6f00
* sane numerals (stage 2): plain "num" syntax (removed "#");
 
wenzelm 
parents: 
11701 
diff
changeset
 | 
568  | 
test "9*x <= 12 * (y::nat)";  | 
| 10704 | 569  | 
|
570  | 
(*cancel_factor*)  | 
|
571  | 
test "x*k = k*(y::nat)";  | 
|
572  | 
test "k = k*(y::nat)";  | 
|
573  | 
test "a*(b*c) = (b::nat)";  | 
|
574  | 
test "a*(b*c) = d*(b::nat)*(x*a)";  | 
|
575  | 
||
576  | 
test "x*k < k*(y::nat)";  | 
|
577  | 
test "k < k*(y::nat)";  | 
|
578  | 
test "a*(b*c) < (b::nat)";  | 
|
579  | 
test "a*(b*c) < d*(b::nat)*(x*a)";  | 
|
580  | 
||
581  | 
test "x*k <= k*(y::nat)";  | 
|
582  | 
test "k <= k*(y::nat)";  | 
|
583  | 
test "a*(b*c) <= (b::nat)";  | 
|
584  | 
test "a*(b*c) <= d*(b::nat)*(x*a)";  | 
|
585  | 
||
586  | 
test "(x*k) div (k*(y::nat)) = (uu::nat)";  | 
|
587  | 
test "(k) div (k*(y::nat)) = (uu::nat)";  | 
|
588  | 
test "(a*(b*c)) div ((b::nat)) = (uu::nat)";  | 
|
589  | 
test "(a*(b*c)) div (d*(b::nat)*(x*a)) = (uu::nat)";  | 
|
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
590  | 
*)  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
591  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
592  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
593  | 
(*** Prepare linear arithmetic for nat numerals ***)  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
594  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
595  | 
local  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
596  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
597  | 
(* reduce contradictory <= to False *)  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
598  | 
val add_rules =  | 
| 
11868
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
599  | 
[thm "Let_number_of", thm "Let_0", thm "Let_1", nat_0, nat_1,  | 
| 
 
56db9f3a6b3e
Numerals now work for the integers: the binary numerals for 0 and 1 rewrite
 
paulson 
parents: 
11704 
diff
changeset
 | 
600  | 
add_nat_number_of, diff_nat_number_of, mult_nat_number_of,  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
601  | 
eq_nat_number_of, less_nat_number_of, le_nat_number_of_eq_not_less,  | 
| 11296 | 602  | 
le_Suc_number_of,le_number_of_Suc,  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
603  | 
less_Suc_number_of,less_number_of_Suc,  | 
| 11296 | 604  | 
Suc_eq_number_of,eq_number_of_Suc,  | 
| 
11334
 
a16eaf2a1edd
Allow Suc-numerals as coefficients in lin-arith formulae
 
nipkow 
parents: 
11297 
diff
changeset
 | 
605  | 
mult_0, mult_0_right, mult_Suc, mult_Suc_right,  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
606  | 
eq_number_of_0, eq_0_number_of, less_0_number_of,  | 
| 
11701
 
3d51fbf81c17
sane numerals (stage 1): added generic 1, removed 1' and 2 on nat,
 
wenzelm 
parents: 
11377 
diff
changeset
 | 
607  | 
nat_number_of, thm "Let_number_of", if_True, if_False];  | 
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
608  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
609  | 
val simprocs = [Nat_Times_Assoc.conv,  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
610  | 
Nat_Numeral_Simprocs.combine_numerals]@  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
611  | 
Nat_Numeral_Simprocs.cancel_numerals;  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
612  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
613  | 
in  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
614  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
615  | 
val nat_simprocs_setup =  | 
| 10693 | 616  | 
 [Fast_Arith.map_data (fn {add_mono_thms, mult_mono_thms, inj_thms, lessD, simpset} =>
 | 
617  | 
   {add_mono_thms = add_mono_thms, mult_mono_thms = mult_mono_thms,
 | 
|
618  | 
inj_thms = inj_thms, lessD = lessD,  | 
|
| 
9436
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
619  | 
simpset = simpset addsimps add_rules  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
620  | 
addsimprocs simprocs})];  | 
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
621  | 
|
| 
 
62bb04ab4b01
rearranged setup of arithmetic procedures, avoiding global reference values;
 
wenzelm 
parents:  
diff
changeset
 | 
622  | 
end;  |