paulson@2224
|
1 |
(* Title: HOL/Integ/Bin.ML
|
paulson@7074
|
2 |
ID: $Id$
|
paulson@2224
|
3 |
Authors: Lawrence C Paulson, Cambridge University Computer Laboratory
|
paulson@2224
|
4 |
David Spelt, University of Twente
|
nipkow@6060
|
5 |
Tobias Nipkow, Technical University Munich
|
paulson@1632
|
6 |
Copyright 1994 University of Cambridge
|
nipkow@6060
|
7 |
Copyright 1996 University of Twente
|
nipkow@6060
|
8 |
Copyright 1999 TU Munich
|
paulson@1632
|
9 |
|
wenzelm@7708
|
10 |
Arithmetic on binary integers.
|
paulson@1632
|
11 |
*)
|
paulson@1632
|
12 |
|
paulson@1632
|
13 |
(** extra rules for bin_succ, bin_pred, bin_add, bin_mult **)
|
paulson@1632
|
14 |
|
paulson@7008
|
15 |
Goal "NCons Pls False = Pls";
|
paulson@7008
|
16 |
by (Simp_tac 1);
|
paulson@7008
|
17 |
qed "NCons_Pls_0";
|
paulson@1632
|
18 |
|
paulson@7008
|
19 |
Goal "NCons Pls True = Pls BIT True";
|
paulson@7008
|
20 |
by (Simp_tac 1);
|
paulson@7008
|
21 |
qed "NCons_Pls_1";
|
paulson@1632
|
22 |
|
paulson@7008
|
23 |
Goal "NCons Min False = Min BIT False";
|
paulson@7008
|
24 |
by (Simp_tac 1);
|
paulson@7008
|
25 |
qed "NCons_Min_0";
|
paulson@1632
|
26 |
|
paulson@7008
|
27 |
Goal "NCons Min True = Min";
|
paulson@7008
|
28 |
by (Simp_tac 1);
|
paulson@7008
|
29 |
qed "NCons_Min_1";
|
paulson@1632
|
30 |
|
paulson@7008
|
31 |
Goal "bin_succ(w BIT True) = (bin_succ w) BIT False";
|
paulson@7008
|
32 |
by (Simp_tac 1);
|
paulson@7008
|
33 |
qed "bin_succ_1";
|
paulson@1632
|
34 |
|
paulson@7008
|
35 |
Goal "bin_succ(w BIT False) = NCons w True";
|
paulson@7008
|
36 |
by (Simp_tac 1);
|
paulson@7008
|
37 |
qed "bin_succ_0";
|
paulson@1632
|
38 |
|
paulson@7008
|
39 |
Goal "bin_pred(w BIT True) = NCons w False";
|
paulson@7008
|
40 |
by (Simp_tac 1);
|
paulson@7008
|
41 |
qed "bin_pred_1";
|
paulson@1632
|
42 |
|
paulson@7008
|
43 |
Goal "bin_pred(w BIT False) = (bin_pred w) BIT True";
|
paulson@7008
|
44 |
by (Simp_tac 1);
|
paulson@7008
|
45 |
qed "bin_pred_0";
|
paulson@1632
|
46 |
|
paulson@7008
|
47 |
Goal "bin_minus(w BIT True) = bin_pred (NCons (bin_minus w) False)";
|
paulson@7008
|
48 |
by (Simp_tac 1);
|
paulson@7008
|
49 |
qed "bin_minus_1";
|
paulson@1632
|
50 |
|
paulson@7008
|
51 |
Goal "bin_minus(w BIT False) = (bin_minus w) BIT False";
|
paulson@7008
|
52 |
by (Simp_tac 1);
|
paulson@7008
|
53 |
qed "bin_minus_0";
|
paulson@1632
|
54 |
|
paulson@5491
|
55 |
|
paulson@1632
|
56 |
(*** bin_add: binary addition ***)
|
paulson@1632
|
57 |
|
paulson@7008
|
58 |
Goal "bin_add (v BIT True) (w BIT True) = \
|
paulson@7008
|
59 |
\ NCons (bin_add v (bin_succ w)) False";
|
paulson@7008
|
60 |
by (Simp_tac 1);
|
paulson@7008
|
61 |
qed "bin_add_BIT_11";
|
paulson@1632
|
62 |
|
paulson@7008
|
63 |
Goal "bin_add (v BIT True) (w BIT False) = NCons (bin_add v w) True";
|
paulson@7008
|
64 |
by (Simp_tac 1);
|
paulson@7008
|
65 |
qed "bin_add_BIT_10";
|
paulson@1632
|
66 |
|
paulson@7008
|
67 |
Goal "bin_add (v BIT False) (w BIT y) = NCons (bin_add v w) y";
|
paulson@7008
|
68 |
by Auto_tac;
|
paulson@7008
|
69 |
qed "bin_add_BIT_0";
|
paulson@1632
|
70 |
|
paulson@5551
|
71 |
Goal "bin_add w Pls = w";
|
paulson@5551
|
72 |
by (induct_tac "w" 1);
|
paulson@5551
|
73 |
by Auto_tac;
|
paulson@5551
|
74 |
qed "bin_add_Pls_right";
|
paulson@1632
|
75 |
|
paulson@7517
|
76 |
Goal "bin_add w Min = bin_pred w";
|
paulson@7517
|
77 |
by (induct_tac "w" 1);
|
paulson@7517
|
78 |
by Auto_tac;
|
paulson@7517
|
79 |
qed "bin_add_Min_right";
|
paulson@1632
|
80 |
|
paulson@7008
|
81 |
Goal "bin_add (v BIT x) (w BIT y) = \
|
paulson@7008
|
82 |
\ NCons(bin_add v (if x & y then (bin_succ w) else w)) (x~= y)";
|
paulson@7008
|
83 |
by (Simp_tac 1);
|
paulson@7008
|
84 |
qed "bin_add_BIT_BIT";
|
paulson@1632
|
85 |
|
paulson@1632
|
86 |
|
paulson@6036
|
87 |
(*** bin_mult: binary multiplication ***)
|
paulson@1632
|
88 |
|
paulson@7008
|
89 |
Goal "bin_mult (v BIT True) w = bin_add (NCons (bin_mult v w) False) w";
|
paulson@7008
|
90 |
by (Simp_tac 1);
|
paulson@7008
|
91 |
qed "bin_mult_1";
|
paulson@1632
|
92 |
|
paulson@7008
|
93 |
Goal "bin_mult (v BIT False) w = NCons (bin_mult v w) False";
|
paulson@7008
|
94 |
by (Simp_tac 1);
|
paulson@7008
|
95 |
qed "bin_mult_0";
|
paulson@1632
|
96 |
|
paulson@1632
|
97 |
|
paulson@1632
|
98 |
(**** The carry/borrow functions, bin_succ and bin_pred ****)
|
paulson@1632
|
99 |
|
paulson@1632
|
100 |
|
paulson@11868
|
101 |
(** number_of **)
|
paulson@1632
|
102 |
|
paulson@7008
|
103 |
Goal "number_of(NCons w b) = (number_of(w BIT b)::int)";
|
paulson@7008
|
104 |
by (induct_tac "w" 1);
|
paulson@7008
|
105 |
by (ALLGOALS Asm_simp_tac);
|
paulson@7008
|
106 |
qed "number_of_NCons";
|
paulson@1632
|
107 |
|
wenzelm@6910
|
108 |
Addsimps [number_of_NCons];
|
paulson@1632
|
109 |
|
paulson@11868
|
110 |
Goal "number_of(bin_succ w) = (1 + number_of w :: int)";
|
paulson@7008
|
111 |
by (induct_tac "w" 1);
|
paulson@7008
|
112 |
by (ALLGOALS (asm_simp_tac (simpset() addsimps zadd_ac)));
|
paulson@7008
|
113 |
qed "number_of_succ";
|
paulson@1632
|
114 |
|
paulson@11868
|
115 |
Goal "number_of(bin_pred w) = (- 1 + number_of w :: int)";
|
paulson@7008
|
116 |
by (induct_tac "w" 1);
|
paulson@7008
|
117 |
by (ALLGOALS (asm_simp_tac (simpset() addsimps zadd_ac)));
|
paulson@7008
|
118 |
qed "number_of_pred";
|
paulson@1632
|
119 |
|
wenzelm@6910
|
120 |
Goal "number_of(bin_minus w) = (- (number_of w)::int)";
|
wenzelm@6910
|
121 |
by (induct_tac "w" 1);
|
paulson@5491
|
122 |
by (Simp_tac 1);
|
paulson@5491
|
123 |
by (Simp_tac 1);
|
paulson@5491
|
124 |
by (asm_simp_tac (simpset()
|
paulson@5551
|
125 |
delsimps [bin_pred_Pls, bin_pred_Min, bin_pred_BIT]
|
wenzelm@6910
|
126 |
addsimps [number_of_succ,number_of_pred,
|
paulson@5491
|
127 |
zadd_assoc]) 1);
|
wenzelm@6910
|
128 |
qed "number_of_minus";
|
paulson@1632
|
129 |
|
paulson@6036
|
130 |
(*This proof is complicated by the mutual recursion*)
|
wenzelm@6910
|
131 |
Goal "! w. number_of(bin_add v w) = (number_of v + number_of w::int)";
|
paulson@11868
|
132 |
by (induct_tac "v" 1);
|
paulson@11868
|
133 |
by (Simp_tac 1);
|
paulson@11868
|
134 |
by (simp_tac (simpset() addsimps [number_of_pred]) 1);
|
paulson@1632
|
135 |
by (rtac allI 1);
|
berghofe@5184
|
136 |
by (induct_tac "w" 1);
|
paulson@11868
|
137 |
by (ALLGOALS (asm_simp_tac (simpset() addsimps
|
paulson@11868
|
138 |
[bin_add_BIT_BIT, number_of_succ, number_of_pred] @ zadd_ac)));
|
wenzelm@6910
|
139 |
qed_spec_mp "number_of_add";
|
paulson@1632
|
140 |
|
paulson@5779
|
141 |
|
paulson@5779
|
142 |
(*Subtraction*)
|
paulson@5779
|
143 |
Goalw [zdiff_def]
|
wenzelm@6910
|
144 |
"number_of v - number_of w = (number_of(bin_add v (bin_minus w))::int)";
|
wenzelm@6910
|
145 |
by (simp_tac (simpset() addsimps [number_of_add, number_of_minus]) 1);
|
wenzelm@6910
|
146 |
qed "diff_number_of_eq";
|
paulson@5779
|
147 |
|
paulson@11868
|
148 |
bind_thms ("bin_mult_simps",
|
paulson@11868
|
149 |
[int_Suc0_eq_1, zmult_zminus, number_of_minus, number_of_add]);
|
paulson@1632
|
150 |
|
wenzelm@6910
|
151 |
Goal "number_of(bin_mult v w) = (number_of v * number_of w::int)";
|
berghofe@5184
|
152 |
by (induct_tac "v" 1);
|
nipkow@4686
|
153 |
by (simp_tac (simpset() addsimps bin_mult_simps) 1);
|
nipkow@4686
|
154 |
by (simp_tac (simpset() addsimps bin_mult_simps) 1);
|
paulson@5491
|
155 |
by (asm_simp_tac
|
paulson@5540
|
156 |
(simpset() addsimps bin_mult_simps @ [zadd_zmult_distrib] @ zadd_ac) 1);
|
wenzelm@6910
|
157 |
qed "number_of_mult";
|
paulson@1632
|
158 |
|
paulson@5491
|
159 |
|
paulson@6941
|
160 |
(*The correctness of shifting. But it doesn't seem to give a measurable
|
paulson@6941
|
161 |
speed-up.*)
|
wenzelm@11704
|
162 |
Goal "(2::int) * number_of w = number_of (w BIT False)";
|
paulson@6941
|
163 |
by (induct_tac "w" 1);
|
paulson@6941
|
164 |
by (ALLGOALS (asm_simp_tac
|
paulson@6941
|
165 |
(simpset() addsimps bin_mult_simps @ [zadd_zmult_distrib] @ zadd_ac)));
|
paulson@6941
|
166 |
qed "double_number_of_BIT";
|
paulson@6941
|
167 |
|
paulson@6941
|
168 |
|
paulson@11868
|
169 |
(** Converting numerals 0 and 1 to their abstract versions **)
|
paulson@5491
|
170 |
|
paulson@11868
|
171 |
Goal "Numeral0 = (0::int)";
|
paulson@5491
|
172 |
by (Simp_tac 1);
|
paulson@11868
|
173 |
qed "int_numeral_0_eq_0";
|
paulson@5491
|
174 |
|
paulson@11868
|
175 |
Goal "Numeral1 = (1::int)";
|
paulson@11868
|
176 |
by (simp_tac (simpset() addsimps [int_1, int_Suc0_eq_1]) 1);
|
paulson@11868
|
177 |
qed "int_numeral_1_eq_1";
|
paulson@5582
|
178 |
|
paulson@6838
|
179 |
|
paulson@6917
|
180 |
(** Special simplification, for constants only **)
|
paulson@6917
|
181 |
|
paulson@7074
|
182 |
(*Distributive laws for literals*)
|
paulson@6917
|
183 |
Addsimps (map (inst "w" "number_of ?v")
|
paulson@6838
|
184 |
[zadd_zmult_distrib, zadd_zmult_distrib2,
|
paulson@6838
|
185 |
zdiff_zmult_distrib, zdiff_zmult_distrib2]);
|
paulson@6838
|
186 |
|
paulson@6917
|
187 |
Addsimps (map (inst "x" "number_of ?v")
|
paulson@6917
|
188 |
[zless_zminus, zle_zminus, equation_zminus]);
|
paulson@6917
|
189 |
Addsimps (map (inst "y" "number_of ?v")
|
paulson@6917
|
190 |
[zminus_zless, zminus_zle, zminus_equation]);
|
paulson@6917
|
191 |
|
paulson@7074
|
192 |
(*Moving negation out of products*)
|
paulson@7074
|
193 |
Addsimps [zmult_zminus, zmult_zminus_right];
|
paulson@6917
|
194 |
|
paulson@9633
|
195 |
(*Cancellation of constant factors in comparisons (< and <=) *)
|
paulson@9633
|
196 |
Addsimps (map (inst "k" "number_of ?v")
|
paulson@9633
|
197 |
[zmult_zless_cancel1, zmult_zless_cancel2,
|
paulson@9633
|
198 |
zmult_zle_cancel1, zmult_zle_cancel2]);
|
paulson@9633
|
199 |
|
paulson@9633
|
200 |
|
paulson@6838
|
201 |
(** Special-case simplification for small constants **)
|
paulson@6838
|
202 |
|
wenzelm@11704
|
203 |
Goal "-1 * z = -(z::int)";
|
paulson@11868
|
204 |
by (simp_tac (simpset() addsimps zcompare_rls@[int_Suc0_eq_1, zmult_zminus]) 1);
|
paulson@6917
|
205 |
qed "zmult_minus1";
|
paulson@6917
|
206 |
|
wenzelm@11704
|
207 |
Goal "z * -1 = -(z::int)";
|
paulson@11868
|
208 |
by (stac zmult_commute 1 THEN rtac zmult_minus1 1);
|
paulson@6917
|
209 |
qed "zmult_minus1_right";
|
paulson@6917
|
210 |
|
paulson@11868
|
211 |
Addsimps [zmult_minus1, zmult_minus1_right];
|
paulson@6917
|
212 |
|
paulson@8785
|
213 |
(*Negation of a coefficient*)
|
paulson@8785
|
214 |
Goal "- (number_of w) * z = number_of(bin_minus w) * (z::int)";
|
wenzelm@9436
|
215 |
by (simp_tac (simpset() addsimps [number_of_minus, zmult_zminus]) 1);
|
paulson@8785
|
216 |
qed "zminus_number_of_zmult";
|
paulson@8785
|
217 |
Addsimps [zminus_number_of_zmult];
|
paulson@8785
|
218 |
|
paulson@11868
|
219 |
(*Integer unary minus for the abstract constant 1. Cannot be inserted
|
paulson@11868
|
220 |
as a simprule until later: it is number_of_Min re-oriented!*)
|
paulson@11868
|
221 |
Goal "- 1 = (-1::int)";
|
paulson@11868
|
222 |
by (Simp_tac 1);
|
paulson@11868
|
223 |
qed "zminus_1_eq_m1";
|
paulson@6917
|
224 |
|
paulson@11868
|
225 |
Goal "(0 < nat z) = (0 < z)";
|
paulson@11868
|
226 |
by (cut_inst_tac [("w","0")] zless_nat_conj 1);
|
paulson@9945
|
227 |
by Auto_tac;
|
paulson@9945
|
228 |
qed "zero_less_nat_eq";
|
paulson@9945
|
229 |
Addsimps [zero_less_nat_eq];
|
paulson@5747
|
230 |
|
paulson@5747
|
231 |
|
paulson@5491
|
232 |
(** Simplification rules for comparison of binary numbers (Norbert Voelker) **)
|
paulson@5491
|
233 |
|
paulson@5491
|
234 |
(** Equals (=) **)
|
paulson@5491
|
235 |
|
paulson@5491
|
236 |
Goalw [iszero_def]
|
paulson@6997
|
237 |
"((number_of x::int) = number_of y) = \
|
paulson@6997
|
238 |
\ iszero (number_of (bin_add x (bin_minus y)))";
|
paulson@11868
|
239 |
by (simp_tac (simpset()
|
paulson@10701
|
240 |
addsimps zcompare_rls @ [number_of_add, number_of_minus]) 1);
|
wenzelm@6910
|
241 |
qed "eq_number_of_eq";
|
paulson@5491
|
242 |
|
wenzelm@6910
|
243 |
Goalw [iszero_def] "iszero ((number_of Pls)::int)";
|
paulson@5491
|
244 |
by (Simp_tac 1);
|
wenzelm@6910
|
245 |
qed "iszero_number_of_Pls";
|
paulson@5491
|
246 |
|
wenzelm@6910
|
247 |
Goalw [iszero_def] "~ iszero ((number_of Min)::int)";
|
paulson@5491
|
248 |
by (Simp_tac 1);
|
wenzelm@6910
|
249 |
qed "nonzero_number_of_Min";
|
paulson@5491
|
250 |
|
paulson@5491
|
251 |
Goalw [iszero_def]
|
wenzelm@6910
|
252 |
"iszero (number_of (w BIT x)) = (~x & iszero (number_of w::int))";
|
wenzelm@6910
|
253 |
by (int_case_tac "number_of w" 1);
|
paulson@11868
|
254 |
by (ALLGOALS
|
paulson@11868
|
255 |
(asm_simp_tac
|
paulson@11868
|
256 |
(simpset() addsimps zcompare_rls @
|
paulson@11868
|
257 |
[zero_reorient, zminus_zadd_distrib RS sym,
|
paulson@11868
|
258 |
int_Suc0_eq_1 RS sym, zadd_int])));
|
wenzelm@6910
|
259 |
qed "iszero_number_of_BIT";
|
paulson@5491
|
260 |
|
wenzelm@6910
|
261 |
Goal "iszero (number_of (w BIT False)) = iszero (number_of w::int)";
|
wenzelm@6910
|
262 |
by (simp_tac (HOL_ss addsimps [iszero_number_of_BIT]) 1);
|
wenzelm@6910
|
263 |
qed "iszero_number_of_0";
|
paulson@5779
|
264 |
|
wenzelm@6910
|
265 |
Goal "~ iszero (number_of (w BIT True)::int)";
|
wenzelm@6910
|
266 |
by (simp_tac (HOL_ss addsimps [iszero_number_of_BIT]) 1);
|
wenzelm@6910
|
267 |
qed "iszero_number_of_1";
|
paulson@5779
|
268 |
|
paulson@5779
|
269 |
|
paulson@5491
|
270 |
|
paulson@5491
|
271 |
(** Less-than (<) **)
|
paulson@5491
|
272 |
|
paulson@5491
|
273 |
Goalw [zless_def,zdiff_def]
|
wenzelm@11655
|
274 |
"((number_of x::int) < number_of y) \
|
wenzelm@6910
|
275 |
\ = neg (number_of (bin_add x (bin_minus y)))";
|
paulson@5491
|
276 |
by (simp_tac (simpset() addsimps bin_mult_simps) 1);
|
wenzelm@6910
|
277 |
qed "less_number_of_eq_neg";
|
paulson@5491
|
278 |
|
paulson@11868
|
279 |
(*But if Numeral0 is rewritten to 0 then this rule can't be applied:
|
paulson@11868
|
280 |
Numeral0 IS (number_of Pls) *)
|
paulson@11868
|
281 |
Goal "~ neg (number_of Pls)";
|
paulson@11868
|
282 |
by (simp_tac (simpset() addsimps [neg_eq_less_0]) 1);
|
wenzelm@6910
|
283 |
qed "not_neg_number_of_Pls";
|
paulson@5491
|
284 |
|
wenzelm@6910
|
285 |
Goal "neg (number_of Min)";
|
paulson@11868
|
286 |
by (simp_tac (simpset() addsimps [neg_eq_less_0, int_0_less_1]) 1);
|
wenzelm@6910
|
287 |
qed "neg_number_of_Min";
|
paulson@5491
|
288 |
|
wenzelm@6910
|
289 |
Goal "neg (number_of (w BIT x)) = neg (number_of w)";
|
paulson@5491
|
290 |
by (Asm_simp_tac 1);
|
wenzelm@6910
|
291 |
by (int_case_tac "number_of w" 1);
|
paulson@5491
|
292 |
by (ALLGOALS (asm_simp_tac
|
paulson@11868
|
293 |
(simpset() addsimps [int_Suc0_eq_1 RS sym, zadd_int,
|
paulson@11868
|
294 |
neg_eq_less_0, symmetric zdiff_def] @ zcompare_rls)));
|
wenzelm@6910
|
295 |
qed "neg_number_of_BIT";
|
paulson@5491
|
296 |
|
paulson@5491
|
297 |
|
paulson@5491
|
298 |
(** Less-than-or-equals (<=) **)
|
paulson@5491
|
299 |
|
paulson@7033
|
300 |
Goal "(number_of x <= (number_of y::int)) = \
|
paulson@7033
|
301 |
\ (~ number_of y < (number_of x::int))";
|
paulson@7033
|
302 |
by (rtac (linorder_not_less RS sym) 1);
|
wenzelm@6910
|
303 |
qed "le_number_of_eq_not_less";
|
paulson@5491
|
304 |
|
nipkow@9214
|
305 |
(** Absolute value (abs) **)
|
nipkow@9214
|
306 |
|
nipkow@9214
|
307 |
Goalw [zabs_def]
|
nipkow@9214
|
308 |
"abs(number_of x::int) = \
|
nipkow@9214
|
309 |
\ (if number_of x < (0::int) then -number_of x else number_of x)";
|
nipkow@9214
|
310 |
by(rtac refl 1);
|
paulson@11868
|
311 |
qed "zabs_number_of";
|
paulson@11868
|
312 |
|
paulson@11868
|
313 |
(*0 and 1 require special rewrites because they aren't numerals*)
|
paulson@11868
|
314 |
Goal "abs (0::int) = 0";
|
paulson@11868
|
315 |
by (simp_tac (simpset() addsimps [zabs_def]) 1);
|
paulson@11868
|
316 |
qed "zabs_0";
|
paulson@11868
|
317 |
|
paulson@11868
|
318 |
Goal "abs (1::int) = 1";
|
paulson@11868
|
319 |
by (simp_tac (simpset() delsimps [int_0, int_1]
|
paulson@11868
|
320 |
addsimps [int_0 RS sym, int_1 RS sym, zabs_def]) 1);
|
paulson@11868
|
321 |
qed "zabs_1";
|
paulson@11868
|
322 |
|
paulson@11868
|
323 |
(*Re-orientation of the equation nnn=x*)
|
paulson@11868
|
324 |
Goal "(number_of w = x) = (x = number_of w)";
|
paulson@11868
|
325 |
by Auto_tac;
|
paulson@11868
|
326 |
qed "number_of_reorient";
|
paulson@11868
|
327 |
|
paulson@11868
|
328 |
|
paulson@11868
|
329 |
structure Bin_Simprocs =
|
paulson@11868
|
330 |
struct
|
paulson@11868
|
331 |
fun prove_conv name tacs sg (hyps: thm list) (t,u) =
|
paulson@11868
|
332 |
if t aconv u then None
|
paulson@11868
|
333 |
else
|
paulson@11868
|
334 |
let val ct = cterm_of sg (HOLogic.mk_Trueprop (HOLogic.mk_eq (t, u)))
|
paulson@11868
|
335 |
in Some
|
paulson@11868
|
336 |
(prove_goalw_cterm [] ct (K tacs)
|
paulson@11868
|
337 |
handle ERROR => error
|
paulson@11868
|
338 |
("The error(s) above occurred while trying to prove " ^
|
paulson@11868
|
339 |
string_of_cterm ct ^ "\nInternal failure of simproc " ^ name))
|
paulson@11868
|
340 |
end
|
paulson@11868
|
341 |
|
paulson@11868
|
342 |
(*version without the hyps argument*)
|
paulson@11868
|
343 |
fun prove_conv_nohyps name tacs sg = prove_conv name tacs sg []
|
paulson@11868
|
344 |
|
paulson@11868
|
345 |
fun prep_simproc (name, pats, proc) = Simplifier.mk_simproc name pats proc
|
paulson@11868
|
346 |
fun prep_pat s = Thm.read_cterm (Theory.sign_of (the_context())) (s, HOLogic.termT)
|
paulson@11868
|
347 |
val prep_pats = map prep_pat
|
paulson@11868
|
348 |
|
paulson@11868
|
349 |
fun is_numeral (Const("Numeral.number_of", _) $ w) = true
|
paulson@11868
|
350 |
| is_numeral _ = false
|
paulson@11868
|
351 |
|
paulson@11868
|
352 |
fun simplify_meta_eq f_number_of_eq f_eq =
|
paulson@11868
|
353 |
mk_meta_eq ([f_eq, f_number_of_eq] MRS trans)
|
paulson@11868
|
354 |
|
paulson@11868
|
355 |
structure IntAbstractNumeralsData =
|
paulson@11868
|
356 |
struct
|
paulson@11868
|
357 |
val dest_eq = HOLogic.dest_eq o HOLogic.dest_Trueprop o concl_of
|
paulson@11868
|
358 |
val is_numeral = is_numeral
|
paulson@11868
|
359 |
val numeral_0_eq_0 = int_numeral_0_eq_0
|
paulson@11868
|
360 |
val numeral_1_eq_1 = int_numeral_1_eq_1
|
paulson@11868
|
361 |
val prove_conv = prove_conv_nohyps "int_abstract_numerals"
|
paulson@11868
|
362 |
fun norm_tac simps = ALLGOALS (simp_tac (HOL_ss addsimps simps))
|
paulson@11868
|
363 |
val simplify_meta_eq = simplify_meta_eq
|
paulson@11868
|
364 |
end
|
paulson@11868
|
365 |
|
paulson@11868
|
366 |
structure IntAbstractNumerals = AbstractNumeralsFun (IntAbstractNumeralsData)
|
paulson@11868
|
367 |
|
paulson@11868
|
368 |
|
paulson@11868
|
369 |
(*For addition, we already have rules for the operand 0.
|
paulson@11868
|
370 |
Multiplication is omitted because there are already special rules for
|
paulson@11868
|
371 |
both 0 and 1 as operands. Unary minus is trivial, just have - 1 = -1.
|
paulson@11868
|
372 |
For the others, having three patterns is a compromise between just having
|
paulson@11868
|
373 |
one (many spurious calls) and having nine (just too many!) *)
|
paulson@11868
|
374 |
val eval_numerals =
|
paulson@11868
|
375 |
map prep_simproc
|
paulson@11868
|
376 |
[("int_add_eval_numerals",
|
paulson@11868
|
377 |
prep_pats ["(m::int) + 1", "(m::int) + number_of v"],
|
paulson@11868
|
378 |
IntAbstractNumerals.proc (number_of_add RS sym)),
|
paulson@11868
|
379 |
("int_diff_eval_numerals",
|
paulson@11868
|
380 |
prep_pats ["(m::int) - 1", "(m::int) - number_of v"],
|
paulson@11868
|
381 |
IntAbstractNumerals.proc diff_number_of_eq),
|
paulson@11868
|
382 |
("int_eq_eval_numerals",
|
paulson@11868
|
383 |
prep_pats ["(m::int) = 0", "(m::int) = 1", "(m::int) = number_of v"],
|
paulson@11868
|
384 |
IntAbstractNumerals.proc eq_number_of_eq),
|
paulson@11868
|
385 |
("int_less_eval_numerals",
|
paulson@11868
|
386 |
prep_pats ["(m::int) < 0", "(m::int) < 1", "(m::int) < number_of v"],
|
paulson@11868
|
387 |
IntAbstractNumerals.proc less_number_of_eq_neg),
|
paulson@11868
|
388 |
("int_le_eval_numerals",
|
paulson@11868
|
389 |
prep_pats ["(m::int) <= 0", "(m::int) <= 1", "(m::int) <= number_of v"],
|
paulson@11868
|
390 |
IntAbstractNumerals.proc le_number_of_eq_not_less)]
|
paulson@11868
|
391 |
|
paulson@11868
|
392 |
(*reorientation simprules using ==, for the following simproc*)
|
paulson@11868
|
393 |
val meta_zero_reorient = zero_reorient RS eq_reflection
|
paulson@11868
|
394 |
val meta_one_reorient = one_reorient RS eq_reflection
|
paulson@11868
|
395 |
val meta_number_of_reorient = number_of_reorient RS eq_reflection
|
paulson@11868
|
396 |
|
paulson@11868
|
397 |
(*reorientation simplification procedure: reorients (polymorphic)
|
paulson@11868
|
398 |
0 = x, 1 = x, nnn = x provided x isn't 0, 1 or a numeral.*)
|
paulson@11868
|
399 |
fun reorient_proc sg _ (_ $ t $ u) =
|
paulson@11868
|
400 |
case u of
|
paulson@11868
|
401 |
Const("0", _) => None
|
paulson@11868
|
402 |
| Const("1", _) => None
|
paulson@11868
|
403 |
| Const("Numeral.number_of", _) $ _ => None
|
paulson@11868
|
404 |
| _ => Some (case t of
|
paulson@11868
|
405 |
Const("0", _) => meta_zero_reorient
|
paulson@11868
|
406 |
| Const("1", _) => meta_one_reorient
|
paulson@11868
|
407 |
| Const("Numeral.number_of", _) $ _ => meta_number_of_reorient)
|
paulson@11868
|
408 |
|
paulson@11868
|
409 |
val reorient_simproc =
|
paulson@11868
|
410 |
prep_simproc ("reorient_simproc",
|
paulson@11868
|
411 |
prep_pats ["0=x", "1=x", "number_of w = x"],
|
paulson@11868
|
412 |
reorient_proc)
|
paulson@11868
|
413 |
|
paulson@11868
|
414 |
end;
|
paulson@11868
|
415 |
|
paulson@11868
|
416 |
|
paulson@11868
|
417 |
Addsimprocs Bin_Simprocs.eval_numerals;
|
paulson@11868
|
418 |
Addsimprocs [Bin_Simprocs.reorient_simproc];
|
nipkow@9214
|
419 |
|
nipkow@9214
|
420 |
|
paulson@5540
|
421 |
(*Delete the original rewrites, with their clumsy conditional expressions*)
|
paulson@5551
|
422 |
Delsimps [bin_succ_BIT, bin_pred_BIT, bin_minus_BIT,
|
paulson@5551
|
423 |
NCons_Pls, NCons_Min, bin_add_BIT, bin_mult_BIT];
|
paulson@5491
|
424 |
|
paulson@5491
|
425 |
(*Hide the binary representation of integer constants*)
|
wenzelm@6910
|
426 |
Delsimps [number_of_Pls, number_of_Min, number_of_BIT];
|
paulson@5491
|
427 |
|
paulson@11868
|
428 |
|
paulson@11868
|
429 |
|
paulson@8787
|
430 |
(*Simplification of arithmetic operations on integer constants.
|
paulson@8787
|
431 |
Note that bin_pred_Pls, etc. were added to the simpset by primrec.*)
|
paulson@8787
|
432 |
|
paulson@11868
|
433 |
bind_thms ("NCons_simps",
|
paulson@11868
|
434 |
[NCons_Pls_0, NCons_Pls_1, NCons_Min_0, NCons_Min_1, NCons_BIT]);
|
paulson@8787
|
435 |
|
wenzelm@9108
|
436 |
bind_thms ("bin_arith_extra_simps",
|
wenzelm@6910
|
437 |
[number_of_add RS sym,
|
paulson@11868
|
438 |
number_of_minus RS sym, zminus_1_eq_m1,
|
wenzelm@6910
|
439 |
number_of_mult RS sym,
|
paulson@5779
|
440 |
bin_succ_1, bin_succ_0,
|
paulson@5779
|
441 |
bin_pred_1, bin_pred_0,
|
paulson@5779
|
442 |
bin_minus_1, bin_minus_0,
|
paulson@7517
|
443 |
bin_add_Pls_right, bin_add_Min_right,
|
paulson@5779
|
444 |
bin_add_BIT_0, bin_add_BIT_10, bin_add_BIT_11,
|
paulson@11868
|
445 |
diff_number_of_eq, zabs_number_of, zabs_0, zabs_1,
|
wenzelm@9108
|
446 |
bin_mult_1, bin_mult_0] @ NCons_simps);
|
paulson@2224
|
447 |
|
paulson@5779
|
448 |
(*For making a minimal simpset, one must include these default simprules
|
wenzelm@6910
|
449 |
of thy. Also include simp_thms, or at least (~False)=True*)
|
wenzelm@9108
|
450 |
bind_thms ("bin_arith_simps",
|
paulson@5779
|
451 |
[bin_pred_Pls, bin_pred_Min,
|
paulson@5779
|
452 |
bin_succ_Pls, bin_succ_Min,
|
paulson@5779
|
453 |
bin_add_Pls, bin_add_Min,
|
paulson@5779
|
454 |
bin_minus_Pls, bin_minus_Min,
|
wenzelm@9108
|
455 |
bin_mult_Pls, bin_mult_Min] @ bin_arith_extra_simps);
|
paulson@2224
|
456 |
|
paulson@5779
|
457 |
(*Simplification of relational operations*)
|
wenzelm@9108
|
458 |
bind_thms ("bin_rel_simps",
|
wenzelm@6910
|
459 |
[eq_number_of_eq, iszero_number_of_Pls, nonzero_number_of_Min,
|
wenzelm@6910
|
460 |
iszero_number_of_0, iszero_number_of_1,
|
wenzelm@6910
|
461 |
less_number_of_eq_neg,
|
paulson@11868
|
462 |
not_neg_number_of_Pls, not_neg_0, not_neg_1, not_iszero_1,
|
paulson@11868
|
463 |
neg_number_of_Min, neg_number_of_BIT,
|
wenzelm@9108
|
464 |
le_number_of_eq_not_less]);
|
paulson@2224
|
465 |
|
paulson@5779
|
466 |
Addsimps bin_arith_extra_simps;
|
paulson@5779
|
467 |
Addsimps bin_rel_simps;
|
paulson@5510
|
468 |
|
paulson@6997
|
469 |
|
paulson@8764
|
470 |
(** Simplification of arithmetic when nested to the right **)
|
paulson@6997
|
471 |
|
paulson@8764
|
472 |
Goal "number_of v + (number_of w + z) = (number_of(bin_add v w) + z::int)";
|
paulson@8764
|
473 |
by (simp_tac (simpset() addsimps [zadd_assoc RS sym]) 1);
|
paulson@8764
|
474 |
qed "add_number_of_left";
|
paulson@8764
|
475 |
|
paulson@8764
|
476 |
Goal "number_of v * (number_of w * z) = (number_of(bin_mult v w) * z::int)";
|
paulson@8764
|
477 |
by (simp_tac (simpset() addsimps [zmult_assoc RS sym]) 1);
|
paulson@8764
|
478 |
qed "mult_number_of_left";
|
paulson@6997
|
479 |
|
paulson@6997
|
480 |
Goalw [zdiff_def]
|
paulson@6997
|
481 |
"number_of v + (number_of w - c) = number_of(bin_add v w) - (c::int)";
|
paulson@8764
|
482 |
by (rtac add_number_of_left 1);
|
paulson@8764
|
483 |
qed "add_number_of_diff1";
|
paulson@6997
|
484 |
|
paulson@6997
|
485 |
Goal "number_of v + (c - number_of w) = \
|
paulson@6997
|
486 |
\ number_of (bin_add v (bin_minus w)) + (c::int)";
|
paulson@6997
|
487 |
by (stac (diff_number_of_eq RS sym) 1);
|
paulson@6997
|
488 |
by Auto_tac;
|
paulson@8764
|
489 |
qed "add_number_of_diff2";
|
paulson@6997
|
490 |
|
paulson@8764
|
491 |
Addsimps [add_number_of_left, mult_number_of_left,
|
paulson@8764
|
492 |
add_number_of_diff1, add_number_of_diff2];
|
paulson@11868
|
493 |
|
paulson@11868
|
494 |
|
paulson@11868
|
495 |
(** Inserting these natural simprules earlier would break many proofs! **)
|
paulson@11868
|
496 |
|
paulson@11868
|
497 |
(* int (Suc n) = 1 + int n *)
|
paulson@11868
|
498 |
Addsimps [int_Suc];
|
paulson@11868
|
499 |
|
paulson@11868
|
500 |
(* Numeral0 -> 0 and Numeral1 -> 1 *)
|
paulson@11868
|
501 |
Addsimps [int_numeral_0_eq_0, int_numeral_1_eq_1];
|
paulson@11868
|
502 |
|
paulson@11868
|
503 |
|