author | wenzelm |
Thu, 22 Jun 2000 23:04:34 +0200 | |
changeset 9108 | 9fff97d29837 |
parent 8949 | d46adac29b71 |
child 9366 | a83f3abbfc93 |
permissions | -rw-r--r-- |
5508 | 1 |
(* Title: IntDef.ML |
2 |
ID: $Id$ |
|
3 |
Authors: Lawrence C Paulson, Cambridge University Computer Laboratory |
|
4 |
Copyright 1993 University of Cambridge |
|
5 |
||
6 |
The integers as equivalence classes over nat*nat. |
|
7 |
*) |
|
8 |
||
9 |
||
8937 | 10 |
(*Rewrite the overloaded 0::int to (int 0)*) |
11 |
Addsimps [Zero_def]; |
|
12 |
||
5508 | 13 |
(*** Proving that intrel is an equivalence relation ***) |
14 |
||
15 |
val eqa::eqb::prems = goal Arith.thy |
|
16 |
"[| (x1::nat) + y2 = x2 + y1; x2 + y3 = x3 + y2 |] ==> \ |
|
17 |
\ x1 + y3 = x3 + y1"; |
|
18 |
by (res_inst_tac [("k1","x2")] (add_left_cancel RS iffD1) 1); |
|
19 |
by (rtac (add_left_commute RS trans) 1); |
|
20 |
by (stac eqb 1); |
|
21 |
by (rtac (add_left_commute RS trans) 1); |
|
22 |
by (stac eqa 1); |
|
23 |
by (rtac (add_left_commute) 1); |
|
24 |
qed "integ_trans_lemma"; |
|
25 |
||
26 |
(** Natural deduction for intrel **) |
|
27 |
||
28 |
Goalw [intrel_def] "[| x1+y2 = x2+y1|] ==> ((x1,y1),(x2,y2)): intrel"; |
|
29 |
by (Fast_tac 1); |
|
30 |
qed "intrelI"; |
|
31 |
||
32 |
(*intrelE is hard to derive because fast_tac tries hyp_subst_tac so soon*) |
|
33 |
Goalw [intrel_def] |
|
34 |
"p: intrel --> (EX x1 y1 x2 y2. \ |
|
35 |
\ p = ((x1,y1),(x2,y2)) & x1+y2 = x2+y1)"; |
|
36 |
by (Fast_tac 1); |
|
37 |
qed "intrelE_lemma"; |
|
38 |
||
39 |
val [major,minor] = Goal |
|
40 |
"[| p: intrel; \ |
|
41 |
\ !!x1 y1 x2 y2. [| p = ((x1,y1),(x2,y2)); x1+y2 = x2+y1|] ==> Q |] \ |
|
42 |
\ ==> Q"; |
|
43 |
by (cut_facts_tac [major RS (intrelE_lemma RS mp)] 1); |
|
44 |
by (REPEAT (eresolve_tac [asm_rl,exE,conjE,minor] 1)); |
|
45 |
qed "intrelE"; |
|
46 |
||
47 |
AddSIs [intrelI]; |
|
48 |
AddSEs [intrelE]; |
|
49 |
||
50 |
Goal "((x1,y1),(x2,y2)): intrel = (x1+y2 = x2+y1)"; |
|
51 |
by (Fast_tac 1); |
|
52 |
qed "intrel_iff"; |
|
53 |
||
54 |
Goal "(x,x): intrel"; |
|
55 |
by (stac surjective_pairing 1 THEN rtac (refl RS intrelI) 1); |
|
56 |
qed "intrel_refl"; |
|
57 |
||
58 |
Goalw [equiv_def, refl_def, sym_def, trans_def] |
|
7375
2cb340e66d15
tidied, allowing pattern-matching in defs of zadd and zmult
paulson
parents:
7127
diff
changeset
|
59 |
"equiv UNIV intrel"; |
5508 | 60 |
by (fast_tac (claset() addSIs [intrel_refl] |
7375
2cb340e66d15
tidied, allowing pattern-matching in defs of zadd and zmult
paulson
parents:
7127
diff
changeset
|
61 |
addSEs [sym, integ_trans_lemma]) 1); |
5508 | 62 |
qed "equiv_intrel"; |
63 |
||
9108 | 64 |
bind_thm ("equiv_intrel_iff", [equiv_intrel, UNIV_I, UNIV_I] MRS eq_equiv_class_iff); |
5508 | 65 |
|
66 |
Goalw [Integ_def,intrel_def,quotient_def] "intrel^^{(x,y)}:Integ"; |
|
67 |
by (Fast_tac 1); |
|
68 |
qed "intrel_in_integ"; |
|
69 |
||
70 |
Goal "inj_on Abs_Integ Integ"; |
|
71 |
by (rtac inj_on_inverseI 1); |
|
72 |
by (etac Abs_Integ_inverse 1); |
|
73 |
qed "inj_on_Abs_Integ"; |
|
74 |
||
75 |
Addsimps [equiv_intrel_iff, inj_on_Abs_Integ RS inj_on_iff, |
|
76 |
intrel_iff, intrel_in_integ, Abs_Integ_inverse]; |
|
77 |
||
78 |
Goal "inj(Rep_Integ)"; |
|
79 |
by (rtac inj_inverseI 1); |
|
80 |
by (rtac Rep_Integ_inverse 1); |
|
81 |
qed "inj_Rep_Integ"; |
|
82 |
||
83 |
||
5562
02261e6880d1
Renaming of Integ/Integ.* to Integ/Int.*, and renaming of related constants
paulson
parents:
5540
diff
changeset
|
84 |
(** int: the injection from "nat" to "int" **) |
5508 | 85 |
|
5562
02261e6880d1
Renaming of Integ/Integ.* to Integ/Int.*, and renaming of related constants
paulson
parents:
5540
diff
changeset
|
86 |
Goal "inj int"; |
5508 | 87 |
by (rtac injI 1); |
5562
02261e6880d1
Renaming of Integ/Integ.* to Integ/Int.*, and renaming of related constants
paulson
parents:
5540
diff
changeset
|
88 |
by (rewtac int_def); |
5508 | 89 |
by (dtac (inj_on_Abs_Integ RS inj_onD) 1); |
90 |
by (REPEAT (rtac intrel_in_integ 1)); |
|
91 |
by (dtac eq_equiv_class 1); |
|
92 |
by (rtac equiv_intrel 1); |
|
93 |
by (Fast_tac 1); |
|
94 |
by Safe_tac; |
|
95 |
by (Asm_full_simp_tac 1); |
|
6991 | 96 |
qed "inj_int"; |
5508 | 97 |
|
98 |
||
99 |
(**** zminus: unary negation on Integ ****) |
|
100 |
||
7375
2cb340e66d15
tidied, allowing pattern-matching in defs of zadd and zmult
paulson
parents:
7127
diff
changeset
|
101 |
Goalw [congruent_def] "congruent intrel (%(x,y). intrel^^{(y,x)})"; |
2cb340e66d15
tidied, allowing pattern-matching in defs of zadd and zmult
paulson
parents:
7127
diff
changeset
|
102 |
by (Clarify_tac 1); |
5508 | 103 |
by (asm_simp_tac (simpset() addsimps add_ac) 1); |
104 |
qed "zminus_congruent"; |
|
105 |
||
106 |
Goalw [zminus_def] |
|
107 |
"- Abs_Integ(intrel^^{(x,y)}) = Abs_Integ(intrel ^^ {(y,x)})"; |
|
108 |
by (simp_tac (simpset() addsimps |
|
7375
2cb340e66d15
tidied, allowing pattern-matching in defs of zadd and zmult
paulson
parents:
7127
diff
changeset
|
109 |
[equiv_intrel RS UN_equiv_class, zminus_congruent]) 1); |
5508 | 110 |
qed "zminus"; |
111 |
||
7375
2cb340e66d15
tidied, allowing pattern-matching in defs of zadd and zmult
paulson
parents:
7127
diff
changeset
|
112 |
(*Every integer can be written in the form Abs_Integ(...) *) |
5508 | 113 |
val [prem] = Goal "(!!x y. z = Abs_Integ(intrel^^{(x,y)}) ==> P) ==> P"; |
114 |
by (res_inst_tac [("x1","z")] |
|
115 |
(rewrite_rule [Integ_def] Rep_Integ RS quotientE) 1); |
|
116 |
by (dres_inst_tac [("f","Abs_Integ")] arg_cong 1); |
|
117 |
by (res_inst_tac [("p","x")] PairE 1); |
|
118 |
by (rtac prem 1); |
|
119 |
by (asm_full_simp_tac (simpset() addsimps [Rep_Integ_inverse]) 1); |
|
120 |
qed "eq_Abs_Integ"; |
|
121 |
||
122 |
Goal "- (- z) = (z::int)"; |
|
123 |
by (res_inst_tac [("z","z")] eq_Abs_Integ 1); |
|
124 |
by (asm_simp_tac (simpset() addsimps [zminus]) 1); |
|
125 |
qed "zminus_zminus"; |
|
126 |
Addsimps [zminus_zminus]; |
|
127 |
||
5594 | 128 |
Goal "inj(%z::int. -z)"; |
5508 | 129 |
by (rtac injI 1); |
130 |
by (dres_inst_tac [("f","uminus")] arg_cong 1); |
|
131 |
by (Asm_full_simp_tac 1); |
|
132 |
qed "inj_zminus"; |
|
133 |
||
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
134 |
Goalw [int_def] "- (int 0) = int 0"; |
5508 | 135 |
by (simp_tac (simpset() addsimps [zminus]) 1); |
6917 | 136 |
qed "zminus_int0"; |
5508 | 137 |
|
6917 | 138 |
Addsimps [zminus_int0]; |
5508 | 139 |
|
140 |
||
5540 | 141 |
(**** neg: the test for negative integers ****) |
5508 | 142 |
|
143 |
||
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
144 |
Goalw [neg_def, int_def] "~ neg(int n)"; |
5508 | 145 |
by (Simp_tac 1); |
7010
63120b6dca50
more renaming of theorems from _nat to _int (corresponding to a function that
paulson
parents:
6991
diff
changeset
|
146 |
qed "not_neg_int"; |
5508 | 147 |
|
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
148 |
Goalw [neg_def, int_def] "neg(- (int (Suc n)))"; |
5508 | 149 |
by (simp_tac (simpset() addsimps [zminus]) 1); |
7010
63120b6dca50
more renaming of theorems from _nat to _int (corresponding to a function that
paulson
parents:
6991
diff
changeset
|
150 |
qed "neg_zminus_int"; |
5508 | 151 |
|
7010
63120b6dca50
more renaming of theorems from _nat to _int (corresponding to a function that
paulson
parents:
6991
diff
changeset
|
152 |
Addsimps [neg_zminus_int, not_neg_int]; |
5508 | 153 |
|
154 |
||
155 |
(**** zadd: addition on Integ ****) |
|
156 |
||
157 |
Goalw [zadd_def] |
|
158 |
"Abs_Integ(intrel^^{(x1,y1)}) + Abs_Integ(intrel^^{(x2,y2)}) = \ |
|
159 |
\ Abs_Integ(intrel^^{(x1+x2, y1+y2)})"; |
|
7375
2cb340e66d15
tidied, allowing pattern-matching in defs of zadd and zmult
paulson
parents:
7127
diff
changeset
|
160 |
by (asm_simp_tac (simpset() addsimps [UN_UN_split_split_eq]) 1); |
2cb340e66d15
tidied, allowing pattern-matching in defs of zadd and zmult
paulson
parents:
7127
diff
changeset
|
161 |
by (stac (equiv_intrel RS UN_equiv_class2) 1); |
2cb340e66d15
tidied, allowing pattern-matching in defs of zadd and zmult
paulson
parents:
7127
diff
changeset
|
162 |
(*Congruence property for addition*) |
2cb340e66d15
tidied, allowing pattern-matching in defs of zadd and zmult
paulson
parents:
7127
diff
changeset
|
163 |
by (auto_tac (claset(), simpset() addsimps [congruent2_def])); |
5508 | 164 |
qed "zadd"; |
165 |
||
7127
48e235179ffb
added parentheses to cope with a possible reduction of the precedence of unary
paulson
parents:
7010
diff
changeset
|
166 |
Goal "- (z + w) = (- z) + (- w::int)"; |
5508 | 167 |
by (res_inst_tac [("z","z")] eq_Abs_Integ 1); |
168 |
by (res_inst_tac [("z","w")] eq_Abs_Integ 1); |
|
169 |
by (asm_simp_tac (simpset() addsimps [zminus,zadd]) 1); |
|
170 |
qed "zminus_zadd_distrib"; |
|
171 |
Addsimps [zminus_zadd_distrib]; |
|
172 |
||
173 |
Goal "(z::int) + w = w + z"; |
|
174 |
by (res_inst_tac [("z","z")] eq_Abs_Integ 1); |
|
175 |
by (res_inst_tac [("z","w")] eq_Abs_Integ 1); |
|
5540 | 176 |
by (asm_simp_tac (simpset() addsimps add_ac @ [zadd]) 1); |
5508 | 177 |
qed "zadd_commute"; |
178 |
||
179 |
Goal "((z1::int) + z2) + z3 = z1 + (z2 + z3)"; |
|
180 |
by (res_inst_tac [("z","z1")] eq_Abs_Integ 1); |
|
181 |
by (res_inst_tac [("z","z2")] eq_Abs_Integ 1); |
|
182 |
by (res_inst_tac [("z","z3")] eq_Abs_Integ 1); |
|
183 |
by (asm_simp_tac (simpset() addsimps [zadd, add_assoc]) 1); |
|
184 |
qed "zadd_assoc"; |
|
185 |
||
186 |
(*For AC rewriting*) |
|
187 |
Goal "(x::int)+(y+z)=y+(x+z)"; |
|
188 |
by (rtac (zadd_commute RS trans) 1); |
|
189 |
by (rtac (zadd_assoc RS trans) 1); |
|
190 |
by (rtac (zadd_commute RS arg_cong) 1); |
|
191 |
qed "zadd_left_commute"; |
|
192 |
||
193 |
(*Integer addition is an AC operator*) |
|
7428 | 194 |
bind_thms ("zadd_ac", [zadd_assoc,zadd_commute,zadd_left_commute]); |
5508 | 195 |
|
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
196 |
Goalw [int_def] "(int m) + (int n) = int (m + n)"; |
5508 | 197 |
by (simp_tac (simpset() addsimps [zadd]) 1); |
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
198 |
qed "zadd_int"; |
5508 | 199 |
|
5594 | 200 |
Goal "(int m) + (int n + z) = int (m + n) + z"; |
201 |
by (simp_tac (simpset() addsimps [zadd_int, zadd_assoc RS sym]) 1); |
|
202 |
qed "zadd_int_left"; |
|
203 |
||
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
204 |
Goal "int (Suc m) = int 1 + (int m)"; |
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
205 |
by (simp_tac (simpset() addsimps [zadd_int]) 1); |
6717
70b251dc7055
int_Suc->int_Suc_int_1 avoiding confusion with the more useful Bin.int_Suc
paulson
parents:
6674
diff
changeset
|
206 |
qed "int_Suc_int_1"; |
5508 | 207 |
|
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
208 |
Goalw [int_def] "int 0 + z = z"; |
5508 | 209 |
by (res_inst_tac [("z","z")] eq_Abs_Integ 1); |
210 |
by (asm_simp_tac (simpset() addsimps [zadd]) 1); |
|
6917 | 211 |
qed "zadd_int0"; |
5508 | 212 |
|
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
213 |
Goal "z + int 0 = z"; |
5508 | 214 |
by (rtac (zadd_commute RS trans) 1); |
6917 | 215 |
by (rtac zadd_int0 1); |
216 |
qed "zadd_int0_right"; |
|
5508 | 217 |
|
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
218 |
Goalw [int_def] "z + (- z) = int 0"; |
5508 | 219 |
by (res_inst_tac [("z","z")] eq_Abs_Integ 1); |
220 |
by (asm_simp_tac (simpset() addsimps [zminus, zadd, add_commute]) 1); |
|
5594 | 221 |
qed "zadd_zminus_inverse"; |
5508 | 222 |
|
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
223 |
Goal "(- z) + z = int 0"; |
5508 | 224 |
by (rtac (zadd_commute RS trans) 1); |
5594 | 225 |
by (rtac zadd_zminus_inverse 1); |
226 |
qed "zadd_zminus_inverse2"; |
|
5508 | 227 |
|
6917 | 228 |
Addsimps [zadd_int0, zadd_int0_right, |
5594 | 229 |
zadd_zminus_inverse, zadd_zminus_inverse2]; |
5508 | 230 |
|
8949 | 231 |
(*for the instance declaration int :: plus_ac0*) |
232 |
Goal "0 + z = (z::int)"; |
|
233 |
by (Simp_tac 1); |
|
234 |
qed "zadd_zero"; |
|
235 |
||
5508 | 236 |
Goal "z + (- z + w) = (w::int)"; |
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
237 |
by (simp_tac (simpset() addsimps [zadd_assoc RS sym]) 1); |
5508 | 238 |
qed "zadd_zminus_cancel"; |
239 |
||
240 |
Goal "(-z) + (z + w) = (w::int)"; |
|
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
241 |
by (simp_tac (simpset() addsimps [zadd_assoc RS sym]) 1); |
5508 | 242 |
qed "zminus_zadd_cancel"; |
243 |
||
244 |
Addsimps [zadd_zminus_cancel, zminus_zadd_cancel]; |
|
245 |
||
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
246 |
Goal "int 0 - x = -x"; |
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
247 |
by (simp_tac (simpset() addsimps [zdiff_def]) 1); |
6917 | 248 |
qed "zdiff_int0"; |
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
249 |
|
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
250 |
Goal "x - int 0 = x"; |
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
251 |
by (simp_tac (simpset() addsimps [zdiff_def]) 1); |
6917 | 252 |
qed "zdiff_int0_right"; |
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
253 |
|
5594 | 254 |
Goal "x - x = int 0"; |
255 |
by (simp_tac (simpset() addsimps [zdiff_def]) 1); |
|
256 |
qed "zdiff_self"; |
|
257 |
||
6917 | 258 |
Addsimps [zdiff_int0, zdiff_int0_right, zdiff_self]; |
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
259 |
|
5508 | 260 |
|
261 |
(** Lemmas **) |
|
262 |
||
263 |
Goal "(z::int) + v = z' + v' ==> z + (v + w) = z' + (v' + w)"; |
|
264 |
by (asm_simp_tac (simpset() addsimps [zadd_assoc RS sym]) 1); |
|
265 |
qed "zadd_assoc_cong"; |
|
266 |
||
267 |
Goal "(z::int) + (v + w) = v + (z + w)"; |
|
268 |
by (REPEAT (ares_tac [zadd_commute RS zadd_assoc_cong] 1)); |
|
269 |
qed "zadd_assoc_swap"; |
|
270 |
||
271 |
||
272 |
(*Need properties of subtraction? Or use $- just as an abbreviation!*) |
|
273 |
||
274 |
(**** zmult: multiplication on Integ ****) |
|
275 |
||
276 |
Goal "((k::nat) + l) + (m + n) = (k + m) + (n + l)"; |
|
277 |
by (simp_tac (simpset() addsimps add_ac) 1); |
|
278 |
qed "zmult_congruent_lemma"; |
|
279 |
||
7375
2cb340e66d15
tidied, allowing pattern-matching in defs of zadd and zmult
paulson
parents:
7127
diff
changeset
|
280 |
(*Congruence property for multiplication*) |
2cb340e66d15
tidied, allowing pattern-matching in defs of zadd and zmult
paulson
parents:
7127
diff
changeset
|
281 |
Goal "congruent2 intrel \ |
2cb340e66d15
tidied, allowing pattern-matching in defs of zadd and zmult
paulson
parents:
7127
diff
changeset
|
282 |
\ (%p1 p2. (%(x1,y1). (%(x2,y2). \ |
5508 | 283 |
\ intrel^^{(x1*x2 + y1*y2, x1*y2 + y1*x2)}) p2) p1)"; |
284 |
by (rtac (equiv_intrel RS congruent2_commuteI) 1); |
|
285 |
by (pair_tac "w" 2); |
|
286 |
by (rename_tac "z1 z2" 2); |
|
7375
2cb340e66d15
tidied, allowing pattern-matching in defs of zadd and zmult
paulson
parents:
7127
diff
changeset
|
287 |
by (ALLGOALS Clarify_tac); |
5508 | 288 |
by (simp_tac (simpset() addsimps add_ac@mult_ac) 1); |
289 |
by (asm_simp_tac (simpset() delsimps [equiv_intrel_iff] |
|
7375
2cb340e66d15
tidied, allowing pattern-matching in defs of zadd and zmult
paulson
parents:
7127
diff
changeset
|
290 |
addsimps add_ac@mult_ac) 1); |
2cb340e66d15
tidied, allowing pattern-matching in defs of zadd and zmult
paulson
parents:
7127
diff
changeset
|
291 |
by (rtac ([equiv_intrel, intrelI] MRS equiv_class_eq) 1); |
5508 | 292 |
by (rtac (zmult_congruent_lemma RS trans) 1); |
293 |
by (rtac (zmult_congruent_lemma RS trans RS sym) 1); |
|
294 |
by (rtac (zmult_congruent_lemma RS trans RS sym) 1); |
|
295 |
by (rtac (zmult_congruent_lemma RS trans RS sym) 1); |
|
296 |
by (asm_simp_tac (simpset() addsimps [add_mult_distrib RS sym]) 1); |
|
297 |
by (asm_simp_tac (simpset() addsimps add_ac@mult_ac) 1); |
|
298 |
qed "zmult_congruent2"; |
|
299 |
||
300 |
Goalw [zmult_def] |
|
301 |
"Abs_Integ((intrel^^{(x1,y1)})) * Abs_Integ((intrel^^{(x2,y2)})) = \ |
|
302 |
\ Abs_Integ(intrel ^^ {(x1*x2 + y1*y2, x1*y2 + y1*x2)})"; |
|
7375
2cb340e66d15
tidied, allowing pattern-matching in defs of zadd and zmult
paulson
parents:
7127
diff
changeset
|
303 |
by (asm_simp_tac |
2cb340e66d15
tidied, allowing pattern-matching in defs of zadd and zmult
paulson
parents:
7127
diff
changeset
|
304 |
(simpset() addsimps [UN_UN_split_split_eq, zmult_congruent2, |
2cb340e66d15
tidied, allowing pattern-matching in defs of zadd and zmult
paulson
parents:
7127
diff
changeset
|
305 |
equiv_intrel RS UN_equiv_class2]) 1); |
5508 | 306 |
qed "zmult"; |
307 |
||
308 |
Goal "(- z) * w = - (z * (w::int))"; |
|
309 |
by (res_inst_tac [("z","z")] eq_Abs_Integ 1); |
|
310 |
by (res_inst_tac [("z","w")] eq_Abs_Integ 1); |
|
5540 | 311 |
by (asm_simp_tac (simpset() addsimps [zminus, zmult] @ add_ac) 1); |
5508 | 312 |
qed "zmult_zminus"; |
313 |
||
314 |
Goal "(z::int) * w = w * z"; |
|
315 |
by (res_inst_tac [("z","z")] eq_Abs_Integ 1); |
|
316 |
by (res_inst_tac [("z","w")] eq_Abs_Integ 1); |
|
5540 | 317 |
by (asm_simp_tac (simpset() addsimps [zmult] @ add_ac @ mult_ac) 1); |
5508 | 318 |
qed "zmult_commute"; |
319 |
||
320 |
Goal "((z1::int) * z2) * z3 = z1 * (z2 * z3)"; |
|
321 |
by (res_inst_tac [("z","z1")] eq_Abs_Integ 1); |
|
322 |
by (res_inst_tac [("z","z2")] eq_Abs_Integ 1); |
|
323 |
by (res_inst_tac [("z","z3")] eq_Abs_Integ 1); |
|
5540 | 324 |
by (asm_simp_tac (simpset() addsimps [add_mult_distrib2,zmult] @ |
325 |
add_ac @ mult_ac) 1); |
|
5508 | 326 |
qed "zmult_assoc"; |
327 |
||
328 |
(*For AC rewriting*) |
|
329 |
Goal "(z1::int)*(z2*z3) = z2*(z1*z3)"; |
|
330 |
by (rtac (zmult_commute RS trans) 1); |
|
331 |
by (rtac (zmult_assoc RS trans) 1); |
|
332 |
by (rtac (zmult_commute RS arg_cong) 1); |
|
333 |
qed "zmult_left_commute"; |
|
334 |
||
335 |
(*Integer multiplication is an AC operator*) |
|
7428 | 336 |
bind_thms ("zmult_ac", [zmult_assoc, zmult_commute, zmult_left_commute]); |
5508 | 337 |
|
338 |
Goal "((z1::int) + z2) * w = (z1 * w) + (z2 * w)"; |
|
339 |
by (res_inst_tac [("z","z1")] eq_Abs_Integ 1); |
|
340 |
by (res_inst_tac [("z","z2")] eq_Abs_Integ 1); |
|
341 |
by (res_inst_tac [("z","w")] eq_Abs_Integ 1); |
|
342 |
by (asm_simp_tac |
|
5540 | 343 |
(simpset() addsimps [add_mult_distrib2, zadd, zmult] @ |
344 |
add_ac @ mult_ac) 1); |
|
5508 | 345 |
qed "zadd_zmult_distrib"; |
346 |
||
347 |
val zmult_commute'= read_instantiate [("z","w")] zmult_commute; |
|
348 |
||
349 |
Goal "w * (- z) = - (w * (z::int))"; |
|
350 |
by (simp_tac (simpset() addsimps [zmult_commute', zmult_zminus]) 1); |
|
351 |
qed "zmult_zminus_right"; |
|
352 |
||
353 |
Goal "(w::int) * (z1 + z2) = (w * z1) + (w * z2)"; |
|
354 |
by (simp_tac (simpset() addsimps [zmult_commute',zadd_zmult_distrib]) 1); |
|
355 |
qed "zadd_zmult_distrib2"; |
|
356 |
||
6839 | 357 |
Goalw [zdiff_def] "((z1::int) - z2) * w = (z1 * w) - (z2 * w)"; |
358 |
by (stac zadd_zmult_distrib 1); |
|
359 |
by (simp_tac (simpset() addsimps [zmult_zminus]) 1); |
|
360 |
qed "zdiff_zmult_distrib"; |
|
361 |
||
362 |
Goal "(w::int) * (z1 - z2) = (w * z1) - (w * z2)"; |
|
363 |
by (simp_tac (simpset() addsimps [zmult_commute',zdiff_zmult_distrib]) 1); |
|
364 |
qed "zdiff_zmult_distrib2"; |
|
365 |
||
7010
63120b6dca50
more renaming of theorems from _nat to _int (corresponding to a function that
paulson
parents:
6991
diff
changeset
|
366 |
Goalw [int_def] "(int m) * (int n) = int (m * n)"; |
63120b6dca50
more renaming of theorems from _nat to _int (corresponding to a function that
paulson
parents:
6991
diff
changeset
|
367 |
by (simp_tac (simpset() addsimps [zmult]) 1); |
63120b6dca50
more renaming of theorems from _nat to _int (corresponding to a function that
paulson
parents:
6991
diff
changeset
|
368 |
qed "zmult_int"; |
63120b6dca50
more renaming of theorems from _nat to _int (corresponding to a function that
paulson
parents:
6991
diff
changeset
|
369 |
|
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
370 |
Goalw [int_def] "int 0 * z = int 0"; |
5508 | 371 |
by (res_inst_tac [("z","z")] eq_Abs_Integ 1); |
372 |
by (asm_simp_tac (simpset() addsimps [zmult]) 1); |
|
6917 | 373 |
qed "zmult_int0"; |
5508 | 374 |
|
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
375 |
Goalw [int_def] "int 1 * z = z"; |
5508 | 376 |
by (res_inst_tac [("z","z")] eq_Abs_Integ 1); |
377 |
by (asm_simp_tac (simpset() addsimps [zmult]) 1); |
|
6917 | 378 |
qed "zmult_int1"; |
5508 | 379 |
|
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
380 |
Goal "z * int 0 = int 0"; |
6917 | 381 |
by (rtac ([zmult_commute, zmult_int0] MRS trans) 1); |
382 |
qed "zmult_int0_right"; |
|
5508 | 383 |
|
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
384 |
Goal "z * int 1 = z"; |
6917 | 385 |
by (rtac ([zmult_commute, zmult_int1] MRS trans) 1); |
386 |
qed "zmult_int1_right"; |
|
5508 | 387 |
|
6917 | 388 |
Addsimps [zmult_int0, zmult_int0_right, zmult_int1, zmult_int1_right]; |
5508 | 389 |
|
390 |
||
391 |
(* Theorems about less and less_equal *) |
|
392 |
||
393 |
(*This lemma allows direct proofs of other <-properties*) |
|
5562
02261e6880d1
Renaming of Integ/Integ.* to Integ/Int.*, and renaming of related constants
paulson
parents:
5540
diff
changeset
|
394 |
Goalw [zless_def, neg_def, zdiff_def, int_def] |
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
395 |
"(w < z) = (EX n. z = w + int(Suc n))"; |
5508 | 396 |
by (res_inst_tac [("z","z")] eq_Abs_Integ 1); |
397 |
by (res_inst_tac [("z","w")] eq_Abs_Integ 1); |
|
398 |
by (Clarify_tac 1); |
|
399 |
by (asm_full_simp_tac (simpset() addsimps [zadd, zminus]) 1); |
|
400 |
by (safe_tac (claset() addSDs [less_eq_Suc_add])); |
|
401 |
by (res_inst_tac [("x","k")] exI 1); |
|
402 |
by (ALLGOALS (asm_full_simp_tac (simpset() addsimps add_ac))); |
|
403 |
qed "zless_iff_Suc_zadd"; |
|
404 |
||
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
405 |
Goal "z < z + int (Suc n)"; |
5508 | 406 |
by (auto_tac (claset(), |
407 |
simpset() addsimps [zless_iff_Suc_zadd, zadd_assoc, |
|
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
408 |
zadd_int])); |
5508 | 409 |
qed "zless_zadd_Suc"; |
410 |
||
411 |
Goal "[| z1<z2; z2<z3 |] ==> z1 < (z3::int)"; |
|
412 |
by (auto_tac (claset(), |
|
413 |
simpset() addsimps [zless_iff_Suc_zadd, zadd_assoc, |
|
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
414 |
zadd_int])); |
5508 | 415 |
qed "zless_trans"; |
416 |
||
417 |
Goal "!!w::int. z<w ==> ~w<z"; |
|
418 |
by (safe_tac (claset() addSDs [zless_iff_Suc_zadd RS iffD1])); |
|
419 |
by (res_inst_tac [("z","z")] eq_Abs_Integ 1); |
|
420 |
by Safe_tac; |
|
5562
02261e6880d1
Renaming of Integ/Integ.* to Integ/Int.*, and renaming of related constants
paulson
parents:
5540
diff
changeset
|
421 |
by (asm_full_simp_tac (simpset() addsimps [int_def, zadd]) 1); |
5508 | 422 |
qed "zless_not_sym"; |
423 |
||
424 |
(* [| n<m; ~P ==> m<n |] ==> P *) |
|
5540 | 425 |
bind_thm ("zless_asym", zless_not_sym RS swap); |
5508 | 426 |
|
427 |
Goal "!!z::int. ~ z<z"; |
|
428 |
by (resolve_tac [zless_asym RS notI] 1); |
|
429 |
by (REPEAT (assume_tac 1)); |
|
430 |
qed "zless_not_refl"; |
|
431 |
||
432 |
(* z<z ==> R *) |
|
5594 | 433 |
bind_thm ("zless_irrefl", zless_not_refl RS notE); |
5508 | 434 |
AddSEs [zless_irrefl]; |
435 |
||
436 |
Goal "z<w ==> w ~= (z::int)"; |
|
437 |
by (Blast_tac 1); |
|
438 |
qed "zless_not_refl2"; |
|
439 |
||
440 |
(* s < t ==> s ~= t *) |
|
441 |
bind_thm ("zless_not_refl3", zless_not_refl2 RS not_sym); |
|
442 |
||
443 |
||
444 |
(*"Less than" is a linear ordering*) |
|
5540 | 445 |
Goalw [zless_def, neg_def, zdiff_def] |
5508 | 446 |
"z<w | z=w | w<(z::int)"; |
447 |
by (res_inst_tac [("z","z")] eq_Abs_Integ 1); |
|
448 |
by (res_inst_tac [("z","w")] eq_Abs_Integ 1); |
|
449 |
by Safe_tac; |
|
450 |
by (asm_full_simp_tac |
|
451 |
(simpset() addsimps [zadd, zminus, Image_iff, Bex_def]) 1); |
|
452 |
by (res_inst_tac [("m1", "x+ya"), ("n1", "xa+y")] (less_linear RS disjE) 1); |
|
5758
27a2b36efd95
corrected auto_tac (applications of unsafe wrappers)
oheimb
parents:
5594
diff
changeset
|
453 |
by (ALLGOALS (force_tac (claset(), simpset() addsimps add_ac))); |
5508 | 454 |
qed "zless_linear"; |
455 |
||
456 |
Goal "!!w::int. (w ~= z) = (w<z | z<w)"; |
|
457 |
by (cut_facts_tac [zless_linear] 1); |
|
458 |
by (Blast_tac 1); |
|
459 |
qed "int_neq_iff"; |
|
460 |
||
461 |
(*** eliminates ~= in premises ***) |
|
462 |
bind_thm("int_neqE", int_neq_iff RS iffD1 RS disjE); |
|
463 |
||
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
464 |
Goal "(int m = int n) = (m = n)"; |
6991 | 465 |
by (fast_tac (claset() addSEs [inj_int RS injD]) 1); |
5562
02261e6880d1
Renaming of Integ/Integ.* to Integ/Int.*, and renaming of related constants
paulson
parents:
5540
diff
changeset
|
466 |
qed "int_int_eq"; |
02261e6880d1
Renaming of Integ/Integ.* to Integ/Int.*, and renaming of related constants
paulson
parents:
5540
diff
changeset
|
467 |
AddIffs [int_int_eq]; |
5508 | 468 |
|
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
469 |
Goal "(int m < int n) = (m<n)"; |
5508 | 470 |
by (simp_tac (simpset() addsimps [less_iff_Suc_add, zless_iff_Suc_zadd, |
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
471 |
zadd_int]) 1); |
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
472 |
qed "zless_int"; |
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
473 |
Addsimps [zless_int]; |
5508 | 474 |
|
475 |
||
476 |
(*** Properties of <= ***) |
|
477 |
||
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
478 |
Goalw [zle_def, le_def] "(int m <= int n) = (m<=n)"; |
5508 | 479 |
by (Simp_tac 1); |
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
480 |
qed "zle_int"; |
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
481 |
Addsimps [zle_int]; |
5508 | 482 |
|
483 |
Goalw [zle_def] "z <= w ==> z < w | z=(w::int)"; |
|
484 |
by (cut_facts_tac [zless_linear] 1); |
|
485 |
by (blast_tac (claset() addEs [zless_asym]) 1); |
|
486 |
qed "zle_imp_zless_or_eq"; |
|
487 |
||
488 |
Goalw [zle_def] "z<w | z=w ==> z <= (w::int)"; |
|
489 |
by (cut_facts_tac [zless_linear] 1); |
|
490 |
by (blast_tac (claset() addEs [zless_asym]) 1); |
|
491 |
qed "zless_or_eq_imp_zle"; |
|
492 |
||
493 |
Goal "(x <= (y::int)) = (x < y | x=y)"; |
|
494 |
by (REPEAT(ares_tac [iffI, zless_or_eq_imp_zle, zle_imp_zless_or_eq] 1)); |
|
5540 | 495 |
qed "integ_le_less"; |
5508 | 496 |
|
497 |
Goal "w <= (w::int)"; |
|
5540 | 498 |
by (simp_tac (simpset() addsimps [integ_le_less]) 1); |
5508 | 499 |
qed "zle_refl"; |
500 |
||
501 |
Goalw [zle_def] "z < w ==> z <= (w::int)"; |
|
502 |
by (blast_tac (claset() addEs [zless_asym]) 1); |
|
503 |
qed "zless_imp_zle"; |
|
504 |
||
505 |
(* Axiom 'linorder_linear' of class 'linorder': *) |
|
506 |
Goal "(z::int) <= w | w <= z"; |
|
5540 | 507 |
by (simp_tac (simpset() addsimps [integ_le_less]) 1); |
5508 | 508 |
by (cut_facts_tac [zless_linear] 1); |
509 |
by (Blast_tac 1); |
|
510 |
qed "zle_linear"; |
|
511 |
||
512 |
Goal "[| i <= j; j < k |] ==> i < (k::int)"; |
|
513 |
by (dtac zle_imp_zless_or_eq 1); |
|
514 |
by (blast_tac (claset() addIs [zless_trans]) 1); |
|
515 |
qed "zle_zless_trans"; |
|
516 |
||
517 |
Goal "[| i < j; j <= k |] ==> i < (k::int)"; |
|
518 |
by (dtac zle_imp_zless_or_eq 1); |
|
519 |
by (blast_tac (claset() addIs [zless_trans]) 1); |
|
520 |
qed "zless_zle_trans"; |
|
521 |
||
522 |
Goal "[| i <= j; j <= k |] ==> i <= (k::int)"; |
|
523 |
by (EVERY1 [dtac zle_imp_zless_or_eq, dtac zle_imp_zless_or_eq, |
|
524 |
rtac zless_or_eq_imp_zle, |
|
525 |
blast_tac (claset() addIs [zless_trans])]); |
|
526 |
qed "zle_trans"; |
|
527 |
||
528 |
Goal "[| z <= w; w <= z |] ==> z = (w::int)"; |
|
529 |
by (EVERY1 [dtac zle_imp_zless_or_eq, dtac zle_imp_zless_or_eq, |
|
530 |
blast_tac (claset() addEs [zless_asym])]); |
|
531 |
qed "zle_anti_sym"; |
|
532 |
||
533 |
(* Axiom 'order_less_le' of class 'order': *) |
|
534 |
Goal "(w::int) < z = (w <= z & w ~= z)"; |
|
535 |
by (simp_tac (simpset() addsimps [zle_def, int_neq_iff]) 1); |
|
536 |
by (blast_tac (claset() addSEs [zless_asym]) 1); |
|
537 |
qed "int_less_le"; |
|
538 |
||
539 |
(* [| w <= z; w ~= z |] ==> w < z *) |
|
540 |
bind_thm ("zle_neq_implies_zless", [int_less_le, conjI] MRS iffD2); |
|
541 |
||
542 |
||
543 |
||
544 |
(*** Subtraction laws ***) |
|
545 |
||
546 |
Goal "x + (y - z) = (x + y) - (z::int)"; |
|
5540 | 547 |
by (simp_tac (simpset() addsimps zdiff_def::zadd_ac) 1); |
5508 | 548 |
qed "zadd_zdiff_eq"; |
549 |
||
550 |
Goal "(x - y) + z = (x + z) - (y::int)"; |
|
5540 | 551 |
by (simp_tac (simpset() addsimps zdiff_def::zadd_ac) 1); |
5508 | 552 |
qed "zdiff_zadd_eq"; |
553 |
||
554 |
Goal "(x - y) - z = x - (y + (z::int))"; |
|
5540 | 555 |
by (simp_tac (simpset() addsimps zdiff_def::zadd_ac) 1); |
5508 | 556 |
qed "zdiff_zdiff_eq"; |
557 |
||
558 |
Goal "x - (y - z) = (x + z) - (y::int)"; |
|
5540 | 559 |
by (simp_tac (simpset() addsimps zdiff_def::zadd_ac) 1); |
5508 | 560 |
qed "zdiff_zdiff_eq2"; |
561 |
||
562 |
Goalw [zless_def, zdiff_def] "(x-y < z) = (x < z + (y::int))"; |
|
563 |
by (simp_tac (simpset() addsimps zadd_ac) 1); |
|
564 |
qed "zdiff_zless_eq"; |
|
565 |
||
566 |
Goalw [zless_def, zdiff_def] "(x < z-y) = (x + (y::int) < z)"; |
|
567 |
by (simp_tac (simpset() addsimps zadd_ac) 1); |
|
568 |
qed "zless_zdiff_eq"; |
|
569 |
||
570 |
Goalw [zle_def] "(x-y <= z) = (x <= z + (y::int))"; |
|
571 |
by (simp_tac (simpset() addsimps [zless_zdiff_eq]) 1); |
|
572 |
qed "zdiff_zle_eq"; |
|
573 |
||
574 |
Goalw [zle_def] "(x <= z-y) = (x + (y::int) <= z)"; |
|
575 |
by (simp_tac (simpset() addsimps [zdiff_zless_eq]) 1); |
|
576 |
qed "zle_zdiff_eq"; |
|
577 |
||
578 |
Goalw [zdiff_def] "(x-y = z) = (x = z + (y::int))"; |
|
579 |
by (auto_tac (claset(), simpset() addsimps [zadd_assoc])); |
|
580 |
qed "zdiff_eq_eq"; |
|
581 |
||
582 |
Goalw [zdiff_def] "(x = z-y) = (x + (y::int) = z)"; |
|
583 |
by (auto_tac (claset(), simpset() addsimps [zadd_assoc])); |
|
584 |
qed "eq_zdiff_eq"; |
|
585 |
||
586 |
(*This list of rewrites simplifies (in)equalities by bringing subtractions |
|
587 |
to the top and then moving negative terms to the other side. |
|
588 |
Use with zadd_ac*) |
|
9108 | 589 |
bind_thms ("zcompare_rls", |
5508 | 590 |
[symmetric zdiff_def, |
591 |
zadd_zdiff_eq, zdiff_zadd_eq, zdiff_zdiff_eq, zdiff_zdiff_eq2, |
|
592 |
zdiff_zless_eq, zless_zdiff_eq, zdiff_zle_eq, zle_zdiff_eq, |
|
9108 | 593 |
zdiff_eq_eq, eq_zdiff_eq]); |
5508 | 594 |
|
595 |
||
596 |
(** Cancellation laws **) |
|
597 |
||
598 |
Goal "!!w::int. (z + w' = z + w) = (w' = w)"; |
|
599 |
by Safe_tac; |
|
7127
48e235179ffb
added parentheses to cope with a possible reduction of the precedence of unary
paulson
parents:
7010
diff
changeset
|
600 |
by (dres_inst_tac [("f", "%x. x + (-z)")] arg_cong 1); |
5508 | 601 |
by (asm_full_simp_tac (simpset() addsimps zadd_ac) 1); |
602 |
qed "zadd_left_cancel"; |
|
603 |
||
604 |
Addsimps [zadd_left_cancel]; |
|
605 |
||
606 |
Goal "!!z::int. (w' + z = w + z) = (w' = w)"; |
|
607 |
by (asm_full_simp_tac (simpset() addsimps zadd_ac) 1); |
|
608 |
qed "zadd_right_cancel"; |
|
609 |
||
610 |
Addsimps [zadd_right_cancel]; |
|
611 |
||
612 |
||
5594 | 613 |
(** For the cancellation simproc. |
614 |
The idea is to cancel like terms on opposite sides by subtraction **) |
|
615 |
||
616 |
Goal "(x::int) - y = x' - y' ==> (x<y) = (x'<y')"; |
|
617 |
by (asm_simp_tac (simpset() addsimps [zless_def]) 1); |
|
618 |
qed "zless_eqI"; |
|
5508 | 619 |
|
5594 | 620 |
Goal "(x::int) - y = x' - y' ==> (y<=x) = (y'<=x')"; |
621 |
by (dtac zless_eqI 1); |
|
622 |
by (asm_simp_tac (simpset() addsimps [zle_def]) 1); |
|
623 |
qed "zle_eqI"; |
|
5508 | 624 |
|
5594 | 625 |
Goal "(x::int) - y = x' - y' ==> (x=y) = (x'=y')"; |
626 |
by Safe_tac; |
|
627 |
by (ALLGOALS |
|
628 |
(asm_full_simp_tac (simpset() addsimps [eq_zdiff_eq, zdiff_eq_eq]))); |
|
629 |
qed "zeq_eqI"; |
|
5582
a356fb49e69e
many renamings and changes. Simproc for cancelling common terms in relations
paulson
parents:
5562
diff
changeset
|
630 |