2 Author: Jeremy Dawson, NICTA
4 Theorems to do with integers, expressed using Pls, Min, BIT,
5 theorems linking them to lists of booleans, and repeated splitting
9 header "Bool lists and integers"
11 theory Bool_List_Representation
15 subsection {* Operations on lists of booleans *}
17 primrec bl_to_bin_aux :: "bool list \<Rightarrow> int \<Rightarrow> int" where
18 Nil: "bl_to_bin_aux [] w = w"
19 | Cons: "bl_to_bin_aux (b # bs) w =
20 bl_to_bin_aux bs (w BIT (if b then 1 else 0))"
22 definition bl_to_bin :: "bool list \<Rightarrow> int" where
23 bl_to_bin_def : "bl_to_bin bs = bl_to_bin_aux bs Int.Pls"
26 "bl_to_bin bs = bl_to_bin_aux bs 0"
27 by (simp add: bl_to_bin_def Pls_def)
29 primrec bin_to_bl_aux :: "nat \<Rightarrow> int \<Rightarrow> bool list \<Rightarrow> bool list" where
30 Z: "bin_to_bl_aux 0 w bl = bl"
31 | Suc: "bin_to_bl_aux (Suc n) w bl =
32 bin_to_bl_aux n (bin_rest w) ((bin_last w = 1) # bl)"
34 definition bin_to_bl :: "nat \<Rightarrow> int \<Rightarrow> bool list" where
35 bin_to_bl_def : "bin_to_bl n w = bin_to_bl_aux n w []"
37 primrec bl_of_nth :: "nat \<Rightarrow> (nat \<Rightarrow> bool) \<Rightarrow> bool list" where
38 Suc: "bl_of_nth (Suc n) f = f n # bl_of_nth n f"
39 | Z: "bl_of_nth 0 f = []"
41 primrec takefill :: "'a \<Rightarrow> nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where
42 Z: "takefill fill 0 xs = []"
43 | Suc: "takefill fill (Suc n) xs = (
44 case xs of [] => fill # takefill fill n xs
45 | y # ys => y # takefill fill n ys)"
47 definition map2 :: "('a \<Rightarrow> 'b \<Rightarrow> 'c) \<Rightarrow> 'a list \<Rightarrow> 'b list \<Rightarrow> 'c list" where
48 "map2 f as bs = map (split f) (zip as bs)"
50 lemma map2_Nil [simp]: "map2 f [] ys = []"
51 unfolding map2_def by auto
53 lemma map2_Nil2 [simp]: "map2 f xs [] = []"
54 unfolding map2_def by auto
56 lemma map2_Cons [simp]:
57 "map2 f (x # xs) (y # ys) = f x y # map2 f xs ys"
58 unfolding map2_def by auto
61 subsection "Arithmetic in terms of bool lists"
64 Arithmetic operations in terms of the reversed bool list,
65 assuming input list(s) the same length, and don't extend them.
68 primrec rbl_succ :: "bool list => bool list" where
69 Nil: "rbl_succ Nil = Nil"
70 | Cons: "rbl_succ (x # xs) = (if x then False # rbl_succ xs else True # xs)"
72 primrec rbl_pred :: "bool list => bool list" where
73 Nil: "rbl_pred Nil = Nil"
74 | Cons: "rbl_pred (x # xs) = (if x then False # xs else True # rbl_pred xs)"
76 primrec rbl_add :: "bool list => bool list => bool list" where
77 -- "result is length of first arg, second arg may be longer"
78 Nil: "rbl_add Nil x = Nil"
79 | Cons: "rbl_add (y # ys) x = (let ws = rbl_add ys (tl x) in
80 (y ~= hd x) # (if hd x & y then rbl_succ ws else ws))"
82 primrec rbl_mult :: "bool list => bool list => bool list" where
83 -- "result is length of first arg, second arg may be longer"
84 Nil: "rbl_mult Nil x = Nil"
85 | Cons: "rbl_mult (y # ys) x = (let ws = False # rbl_mult ys x in
86 if y then rbl_add ws x else ws)"
89 "(butlast ^^ n) bl = take (length bl - n) bl"
90 by (induct n) (auto simp: butlast_take)
92 lemma bin_to_bl_aux_Pls_minus_simp [simp]:
93 "0 < n ==> bin_to_bl_aux n Int.Pls bl =
94 bin_to_bl_aux (n - 1) Int.Pls (False # bl)"
97 lemma bin_to_bl_aux_Min_minus_simp [simp]:
98 "0 < n ==> bin_to_bl_aux n Int.Min bl =
99 bin_to_bl_aux (n - 1) Int.Min (True # bl)"
102 lemma bin_to_bl_aux_Bit_minus_simp [simp]:
103 "0 < n ==> bin_to_bl_aux n (w BIT b) bl =
104 bin_to_bl_aux (n - 1) w ((b = 1) # bl)"
107 lemma bin_to_bl_aux_Bit0_minus_simp [simp]:
108 "0 < n ==> bin_to_bl_aux n (Int.Bit0 w) bl =
109 bin_to_bl_aux (n - 1) w (False # bl)"
112 lemma bin_to_bl_aux_Bit1_minus_simp [simp]:
113 "0 < n ==> bin_to_bl_aux n (Int.Bit1 w) bl =
114 bin_to_bl_aux (n - 1) w (True # bl)"
117 text {* Link between bin and bool list. *}
119 lemma bl_to_bin_aux_append:
120 "bl_to_bin_aux (bs @ cs) w = bl_to_bin_aux cs (bl_to_bin_aux bs w)"
121 by (induct bs arbitrary: w) auto
123 lemma bin_to_bl_aux_append:
124 "bin_to_bl_aux n w bs @ cs = bin_to_bl_aux n w (bs @ cs)"
125 by (induct n arbitrary: w bs) auto
127 lemma bl_to_bin_append:
128 "bl_to_bin (bs @ cs) = bl_to_bin_aux cs (bl_to_bin bs)"
129 unfolding bl_to_bin_def by (rule bl_to_bin_aux_append)
131 lemma bin_to_bl_aux_alt:
132 "bin_to_bl_aux n w bs = bin_to_bl n w @ bs"
133 unfolding bin_to_bl_def by (simp add : bin_to_bl_aux_append)
135 lemma bin_to_bl_0 [simp]: "bin_to_bl 0 bs = []"
136 unfolding bin_to_bl_def by auto
138 lemma size_bin_to_bl_aux:
139 "size (bin_to_bl_aux n w bs) = n + length bs"
140 by (induct n arbitrary: w bs) auto
142 lemma size_bin_to_bl [simp]: "size (bin_to_bl n w) = n"
143 unfolding bin_to_bl_def by (simp add : size_bin_to_bl_aux)
146 "bl_to_bin (bin_to_bl_aux n w bs) =
147 bl_to_bin_aux bs (bintrunc n w)"
148 by (induct n arbitrary: w bs) (auto simp add : bl_to_bin_def)
150 lemma bin_bl_bin [simp]: "bl_to_bin (bin_to_bl n w) = bintrunc n w"
151 unfolding bin_to_bl_def bin_bl_bin' by auto
154 "bin_to_bl (n + length bs) (bl_to_bin_aux bs w) =
155 bin_to_bl_aux n w bs"
156 apply (induct bs arbitrary: w n)
158 apply (simp_all only : add_Suc [symmetric])
159 apply (auto simp add : bin_to_bl_def)
162 lemma bl_bin_bl [simp]: "bin_to_bl (length bs) (bl_to_bin bs) = bs"
163 unfolding bl_to_bin_def
164 apply (rule box_equals)
165 apply (rule bl_bin_bl')
167 apply (rule bin_to_bl_aux.Z)
172 "bl_to_bin bs = bl_to_bin cs ==> length bs = length cs ==> bs = cs"
173 apply (rule_tac box_equals)
175 apply (rule bl_bin_bl)
176 apply (rule bl_bin_bl)
180 lemma bl_to_bin_False [simp]: "bl_to_bin (False # bl) = bl_to_bin bl"
181 unfolding bl_to_bin_def by (auto simp: BIT_simps)
183 lemma bl_to_bin_Nil [simp]: "bl_to_bin [] = Int.Pls"
184 unfolding bl_to_bin_def by auto
186 lemma bin_to_bl_Pls_aux:
187 "bin_to_bl_aux n Int.Pls bl = replicate n False @ bl"
188 by (induct n arbitrary: bl) (auto simp: replicate_app_Cons_same)
190 lemma bin_to_bl_Pls: "bin_to_bl n Int.Pls = replicate n False"
191 unfolding bin_to_bl_def by (simp add : bin_to_bl_Pls_aux)
193 lemma bin_to_bl_Min_aux [rule_format] :
194 "ALL bl. bin_to_bl_aux n Int.Min bl = replicate n True @ bl"
195 by (induct n) (auto simp: replicate_app_Cons_same)
197 lemma bin_to_bl_Min: "bin_to_bl n Int.Min = replicate n True"
198 unfolding bin_to_bl_def by (simp add : bin_to_bl_Min_aux)
200 lemma bl_to_bin_rep_F:
201 "bl_to_bin (replicate n False @ bl) = bl_to_bin bl"
202 apply (simp add: bin_to_bl_Pls_aux [symmetric] bin_bl_bin')
203 apply (simp add: bl_to_bin_def)
206 lemma bin_to_bl_trunc [simp]:
207 "n <= m ==> bin_to_bl n (bintrunc m w) = bin_to_bl n w"
208 by (auto intro: bl_to_bin_inj)
210 lemma bin_to_bl_aux_bintr [rule_format] :
211 "ALL m bin bl. bin_to_bl_aux n (bintrunc m bin) bl =
212 replicate (n - m) False @ bin_to_bl_aux (min n m) bin bl"
217 apply (clarsimp simp: bin_to_bl_Pls_aux)
218 apply (erule thin_rl)
223 lemma bin_to_bl_bintr:
224 "bin_to_bl n (bintrunc m bin) =
225 replicate (n - m) False @ bin_to_bl (min n m) bin"
226 unfolding bin_to_bl_def by (rule bin_to_bl_aux_bintr)
228 lemma bl_to_bin_rep_False: "bl_to_bin (replicate n False) = Int.Pls"
231 lemma len_bin_to_bl_aux:
232 "length (bin_to_bl_aux n w bs) = n + length bs"
233 by (induct n arbitrary: w bs) auto
235 lemma len_bin_to_bl [simp]: "length (bin_to_bl n w) = n"
236 unfolding bin_to_bl_def len_bin_to_bl_aux by auto
239 "bin_sign (bl_to_bin_aux bs w) = bin_sign w"
240 by (induct bs arbitrary: w) auto
242 lemma sign_bl_bin: "bin_sign (bl_to_bin bs) = Int.Pls"
243 unfolding bl_to_bin_def by (simp add : sign_bl_bin')
245 lemma bl_sbin_sign_aux:
246 "hd (bin_to_bl_aux (Suc n) w bs) =
247 (bin_sign (sbintrunc n w) = Int.Min)"
248 apply (induct n arbitrary: w bs)
250 apply (cases w rule: bin_exhaust)
251 apply (simp split add : bit.split)
256 "hd (bin_to_bl (Suc n) w) = (bin_sign (sbintrunc n w) = Int.Min)"
257 unfolding bin_to_bl_def by (rule bl_sbin_sign_aux)
259 lemma bin_nth_of_bl_aux [rule_format]:
260 "\<forall>w. bin_nth (bl_to_bin_aux bl w) n =
261 (n < size bl & rev bl ! n | n >= length bl & bin_nth w (n - size bl))"
262 apply (induct_tac bl)
265 apply (cut_tac x=n and y="size list" in linorder_less_linear)
266 apply (erule disjE, simp add: nth_append)+
270 lemma bin_nth_of_bl: "bin_nth (bl_to_bin bl) n = (n < length bl & rev bl ! n)"
271 unfolding bl_to_bin_def by (simp add : bin_nth_of_bl_aux)
273 lemma bin_nth_bl [rule_format] : "ALL m w. n < m -->
274 bin_nth w n = nth (rev (bin_to_bl m w)) n"
277 apply (case_tac m, clarsimp)
278 apply (clarsimp simp: bin_to_bl_def)
279 apply (simp add: bin_to_bl_aux_alt)
281 apply (case_tac m, clarsimp)
282 apply (clarsimp simp: bin_to_bl_def)
283 apply (simp add: bin_to_bl_aux_alt)
286 lemma nth_rev [rule_format] :
287 "n < length xs --> rev xs ! n = xs ! (length xs - 1 - n)"
288 apply (induct_tac "xs")
290 apply (clarsimp simp add : nth_append nth.simps split add : nat.split)
291 apply (rule_tac f = "%n. list ! n" in arg_cong)
295 lemma nth_rev_alt: "n < length ys \<Longrightarrow> ys ! n = rev ys ! (length ys - Suc n)"
296 by (simp add: nth_rev)
298 lemma nth_bin_to_bl_aux [rule_format] :
299 "ALL w n bl. n < m + length bl --> (bin_to_bl_aux m w bl) ! n =
300 (if n < m then bin_nth w (m - 1 - n) else bl ! (n - m))"
304 apply (case_tac w rule: bin_exhaust)
308 lemma nth_bin_to_bl: "n < m ==> (bin_to_bl m w) ! n = bin_nth w (m - Suc n)"
309 unfolding bin_to_bl_def by (simp add : nth_bin_to_bl_aux)
311 lemma bl_to_bin_lt2p_aux [rule_format]:
312 "\<forall>w. bl_to_bin_aux bs w < (w + 1) * (2 ^ length bs)"
317 apply (erule allE, erule xtr8 [rotated],
318 simp add: numeral_simps algebra_simps BIT_simps
319 cong add: number_of_False_cong)+
322 lemma bl_to_bin_lt2p: "bl_to_bin bs < (2 ^ length bs)"
323 apply (unfold bl_to_bin_def)
326 apply (rule bl_to_bin_lt2p_aux)
330 lemma bl_to_bin_ge2p_aux [rule_format] :
331 "\<forall>w. bl_to_bin_aux bs w >= w * (2 ^ length bs)"
336 apply (erule allE, erule preorder_class.order_trans [rotated],
337 simp add: numeral_simps algebra_simps BIT_simps
338 cong add: number_of_False_cong)+
341 lemma bl_to_bin_ge0: "bl_to_bin bs >= 0"
342 apply (unfold bl_to_bin_def)
344 apply (rule bl_to_bin_ge2p_aux)
345 apply (simp add: Pls_def)
348 lemma butlast_rest_bin:
349 "butlast (bin_to_bl n w) = bin_to_bl (n - 1) (bin_rest w)"
350 apply (unfold bin_to_bl_def)
351 apply (cases w rule: bin_exhaust)
352 apply (cases n, clarsimp)
354 apply (auto simp add: bin_to_bl_aux_alt)
357 lemma butlast_bin_rest:
358 "butlast bl = bin_to_bl (length bl - Suc 0) (bin_rest (bl_to_bin bl))"
359 using butlast_rest_bin [where w="bl_to_bin bl" and n="length bl"] by simp
361 lemma butlast_rest_bl2bin_aux:
362 "bl ~= [] \<Longrightarrow>
363 bl_to_bin_aux (butlast bl) w = bin_rest (bl_to_bin_aux bl w)"
364 by (induct bl arbitrary: w) auto
366 lemma butlast_rest_bl2bin:
367 "bl_to_bin (butlast bl) = bin_rest (bl_to_bin bl)"
368 apply (unfold bl_to_bin_def)
370 apply (auto simp add: butlast_rest_bl2bin_aux)
373 lemma trunc_bl2bin_aux [rule_format]:
374 "ALL w. bintrunc m (bl_to_bin_aux bl w) =
375 bl_to_bin_aux (drop (length bl - m) bl) (bintrunc (m - length bl) w)"
376 apply (induct_tac bl)
380 apply (case_tac "m - size list")
381 apply (simp add : diff_is_0_eq [THEN iffD1, THEN Suc_diff_le])
382 apply (simp add: BIT_simps)
383 apply (rule_tac f = "%nat. bl_to_bin_aux list (Int.Bit1 (bintrunc nat w))"
386 apply (case_tac "m - size list")
387 apply (simp add: diff_is_0_eq [THEN iffD1, THEN Suc_diff_le])
388 apply (simp add: BIT_simps)
389 apply (rule_tac f = "%nat. bl_to_bin_aux list (Int.Bit0 (bintrunc nat w))"
395 "bintrunc m (bl_to_bin bl) = bl_to_bin (drop (length bl - m) bl)"
396 unfolding bl_to_bin_def by (simp add : trunc_bl2bin_aux)
398 lemma trunc_bl2bin_len [simp]:
399 "bintrunc (length bl) (bl_to_bin bl) = bl_to_bin bl"
400 by (simp add: trunc_bl2bin)
403 "bl_to_bin (drop k bl) = bintrunc (length bl - k) (bl_to_bin bl)"
406 apply (rule trunc_bl2bin [symmetric])
407 apply (cases "k <= length bl")
411 lemma nth_rest_power_bin [rule_format] :
412 "ALL n. bin_nth ((bin_rest ^^ k) w) n = bin_nth w (n + k)"
413 apply (induct k, clarsimp)
415 apply (simp only: bin_nth.Suc [symmetric] add_Suc)
418 lemma take_rest_power_bin:
419 "m <= n ==> take m (bin_to_bl n w) = bin_to_bl m ((bin_rest ^^ (n - m)) w)"
420 apply (rule nth_equalityI)
422 apply (clarsimp simp add: nth_bin_to_bl nth_rest_power_bin)
425 lemma hd_butlast: "size xs > 1 ==> hd (butlast xs) = hd xs"
428 lemma last_bin_last':
429 "size xs > 0 \<Longrightarrow> last xs = (bin_last (bl_to_bin_aux xs w) = 1)"
430 by (induct xs arbitrary: w) auto
433 "size xs > 0 ==> last xs = (bin_last (bl_to_bin xs) = 1)"
434 unfolding bl_to_bin_def by (erule last_bin_last')
437 "bin_last w = (if last (bin_to_bl (Suc n) w) then 1 else 0)"
438 apply (unfold bin_to_bl_def)
440 apply (auto simp add: bin_to_bl_aux_alt)
443 (** links between bit-wise operations and operations on bool lists **)
445 lemma bl_xor_aux_bin [rule_format] : "ALL v w bs cs.
446 map2 (%x y. x ~= y) (bin_to_bl_aux n v bs) (bin_to_bl_aux n w cs) =
447 bin_to_bl_aux n (v XOR w) (map2 (%x y. x ~= y) bs cs)"
451 apply (case_tac v rule: bin_exhaust)
452 apply (case_tac w rule: bin_exhaust)
455 apply (case_tac ba, safe, simp_all)+
458 lemma bl_or_aux_bin [rule_format] : "ALL v w bs cs.
459 map2 (op | ) (bin_to_bl_aux n v bs) (bin_to_bl_aux n w cs) =
460 bin_to_bl_aux n (v OR w) (map2 (op | ) bs cs)"
464 apply (case_tac v rule: bin_exhaust)
465 apply (case_tac w rule: bin_exhaust)
468 apply (case_tac ba, safe, simp_all)+
471 lemma bl_and_aux_bin [rule_format] : "ALL v w bs cs.
472 map2 (op & ) (bin_to_bl_aux n v bs) (bin_to_bl_aux n w cs) =
473 bin_to_bl_aux n (v AND w) (map2 (op & ) bs cs)"
477 apply (case_tac v rule: bin_exhaust)
478 apply (case_tac w rule: bin_exhaust)
482 lemma bl_not_aux_bin [rule_format] :
483 "ALL w cs. map Not (bin_to_bl_aux n w cs) =
484 bin_to_bl_aux n (NOT w) (map Not cs)"
490 lemma bl_not_bin: "map Not (bin_to_bl n w) = bin_to_bl n (NOT w)"
491 unfolding bin_to_bl_def by (simp add: bl_not_aux_bin)
494 "map2 (op \<and>) (bin_to_bl n v) (bin_to_bl n w) = bin_to_bl n (v AND w)"
495 unfolding bin_to_bl_def by (simp add: bl_and_aux_bin)
498 "map2 (op \<or>) (bin_to_bl n v) (bin_to_bl n w) = bin_to_bl n (v OR w)"
499 unfolding bin_to_bl_def by (simp add: bl_or_aux_bin)
502 "map2 (\<lambda>x y. x \<noteq> y) (bin_to_bl n v) (bin_to_bl n w) = bin_to_bl n (v XOR w)"
503 unfolding bin_to_bl_def by (simp only: bl_xor_aux_bin map2_Nil)
505 lemma drop_bin2bl_aux [rule_format] :
506 "ALL m bin bs. drop m (bin_to_bl_aux n bin bs) =
507 bin_to_bl_aux (n - m) bin (drop (m - n) bs)"
508 apply (induct n, clarsimp)
510 apply (case_tac bin rule: bin_exhaust)
511 apply (case_tac "m <= n", simp)
512 apply (case_tac "m - n", simp)
514 apply (rule_tac f = "%nat. drop nat bs" in arg_cong)
518 lemma drop_bin2bl: "drop m (bin_to_bl n bin) = bin_to_bl (n - m) bin"
519 unfolding bin_to_bl_def by (simp add : drop_bin2bl_aux)
521 lemma take_bin2bl_lem1 [rule_format] :
522 "ALL w bs. take m (bin_to_bl_aux m w bs) = bin_to_bl m w"
523 apply (induct m, clarsimp)
525 apply (simp add: bin_to_bl_aux_alt)
526 apply (simp add: bin_to_bl_def)
527 apply (simp add: bin_to_bl_aux_alt)
530 lemma take_bin2bl_lem [rule_format] :
531 "ALL w bs. take m (bin_to_bl_aux (m + n) w bs) =
532 take m (bin_to_bl (m + n) w)"
535 apply (simp_all (no_asm) add: bin_to_bl_def take_bin2bl_lem1)
539 lemma bin_split_take [rule_format] :
540 "ALL b c. bin_split n c = (a, b) -->
541 bin_to_bl m a = take m (bin_to_bl (m + n) c)"
544 apply (clarsimp simp: Let_def split: ls_splits)
545 apply (simp add: bin_to_bl_def)
546 apply (simp add: take_bin2bl_lem)
549 lemma bin_split_take1:
550 "k = m + n ==> bin_split n c = (a, b) ==>
551 bin_to_bl m a = take m (bin_to_bl k c)"
552 by (auto elim: bin_split_take)
554 lemma nth_takefill [rule_format] : "ALL m l. m < n -->
555 takefill fill n l ! m = (if m < length l then l ! m else fill)"
556 apply (induct n, clarsimp)
559 apply (simp split: list.split)
562 apply (erule (1) impE)
563 apply (simp split: list.split)
566 lemma takefill_alt [rule_format] :
567 "ALL l. takefill fill n l = take n l @ replicate (n - length l) fill"
568 by (induct n) (auto split: list.split)
570 lemma takefill_replicate [simp]:
571 "takefill fill n (replicate m fill) = replicate n fill"
572 by (simp add : takefill_alt replicate_add [symmetric])
574 lemma takefill_le' [rule_format] :
575 "ALL l n. n = m + k --> takefill x m (takefill x n l) = takefill x m l"
576 by (induct m) (auto split: list.split)
578 lemma length_takefill [simp]: "length (takefill fill n l) = n"
579 by (simp add : takefill_alt)
581 lemma take_takefill':
582 "!!w n. n = k + m ==> take k (takefill fill n w) = takefill fill k w"
583 by (induct k) (auto split add : list.split)
586 "!!w. drop k (takefill fill (m + k) w) = takefill fill m (drop k w)"
587 by (induct k) (auto split add : list.split)
589 lemma takefill_le [simp]:
590 "m \<le> n \<Longrightarrow> takefill x m (takefill x n l) = takefill x m l"
591 by (auto simp: le_iff_add takefill_le')
593 lemma take_takefill [simp]:
594 "m \<le> n \<Longrightarrow> take m (takefill fill n w) = takefill fill m w"
595 by (auto simp: le_iff_add take_takefill')
597 lemma takefill_append:
598 "takefill fill (m + length xs) (xs @ w) = xs @ (takefill fill m w)"
601 lemma takefill_same':
602 "l = length xs ==> takefill fill l xs = xs"
603 by clarify (induct xs, auto)
605 lemmas takefill_same [simp] = takefill_same' [OF refl]
607 lemma takefill_bintrunc:
608 "takefill False n bl = rev (bin_to_bl n (bl_to_bin (rev bl)))"
609 apply (rule nth_equalityI)
611 apply (clarsimp simp: nth_takefill nth_rev nth_bin_to_bl bin_nth_of_bl)
615 "bin_to_bl n (bl_to_bin bl) = rev (takefill False n (rev bl))"
616 by (simp add : takefill_bintrunc)
618 lemma bl_bin_bl_rep_drop:
619 "bin_to_bl n (bl_to_bin bl) =
620 replicate (n - length bl) False @ drop (length bl - n) bl"
621 by (simp add: bl_bin_bl_rtf takefill_alt rev_take)
624 "n + k = m + length bl ==> takefill x m (rev (takefill y n bl)) =
625 rev (takefill y m (rev (takefill x k (rev bl))))"
626 apply (rule nth_equalityI)
627 apply (auto simp add: nth_takefill nth_rev)
628 apply (rule_tac f = "%n. bl ! n" in arg_cong)
632 lemma takefill_minus:
633 "0 < n ==> takefill fill (Suc (n - 1)) w = takefill fill n w"
636 lemmas takefill_Suc_cases =
637 list.cases [THEN takefill.Suc [THEN trans]]
639 lemmas takefill_Suc_Nil = takefill_Suc_cases (1)
640 lemmas takefill_Suc_Cons = takefill_Suc_cases (2)
642 lemmas takefill_minus_simps = takefill_Suc_cases [THEN [2]
643 takefill_minus [symmetric, THEN trans]]
645 lemmas takefill_pred_simps [simp] =
646 takefill_minus_simps [where n="number_of bin", simplified nobm1] for bin
648 (* links with function bl_to_bin *)
650 lemma bl_to_bin_aux_cat:
651 "!!nv v. bl_to_bin_aux bs (bin_cat w nv v) =
652 bin_cat w (nv + length bs) (bl_to_bin_aux bs v)"
655 apply (simp add: bin_cat_Suc_Bit [symmetric] del: bin_cat.simps)
658 lemma bin_to_bl_aux_cat:
659 "!!w bs. bin_to_bl_aux (nv + nw) (bin_cat v nw w) bs =
660 bin_to_bl_aux nv v (bin_to_bl_aux nw w bs)"
663 lemma bl_to_bin_aux_alt:
664 "bl_to_bin_aux bs w = bin_cat w (length bs) (bl_to_bin bs)"
665 using bl_to_bin_aux_cat [where nv = "0" and v = "Int.Pls"]
666 unfolding bl_to_bin_def [symmetric] by simp
669 "bin_to_bl (nv + nw) (bin_cat v nw w) =
670 bin_to_bl_aux nv v (bin_to_bl nw w)"
671 unfolding bin_to_bl_def by (simp add: bin_to_bl_aux_cat)
673 lemmas bl_to_bin_aux_app_cat =
674 trans [OF bl_to_bin_aux_append bl_to_bin_aux_alt]
676 lemmas bin_to_bl_aux_cat_app =
677 trans [OF bin_to_bl_aux_cat bin_to_bl_aux_alt]
679 lemma bl_to_bin_app_cat:
680 "bl_to_bin (bsa @ bs) = bin_cat (bl_to_bin bsa) (length bs) (bl_to_bin bs)"
681 by (simp only: bl_to_bin_aux_app_cat bl_to_bin_def)
683 lemma bin_to_bl_cat_app:
684 "bin_to_bl (n + nw) (bin_cat w nw wa) = bin_to_bl n w @ bin_to_bl nw wa"
685 by (simp only: bin_to_bl_def bin_to_bl_aux_cat_app)
687 (* bl_to_bin_app_cat_alt and bl_to_bin_app_cat are easily interderivable *)
688 lemma bl_to_bin_app_cat_alt:
689 "bin_cat (bl_to_bin cs) n w = bl_to_bin (cs @ bin_to_bl n w)"
690 by (simp add : bl_to_bin_app_cat)
692 lemma mask_lem: "(bl_to_bin (True # replicate n False)) =
693 Int.succ (bl_to_bin (replicate n True))"
694 apply (unfold bl_to_bin_def)
696 apply (simp add: BIT_simps)
697 apply (simp only: Suc_eq_plus1 replicate_add
698 append_Cons [symmetric] bl_to_bin_aux_append)
699 apply (simp add: BIT_simps)
702 (* function bl_of_nth *)
703 lemma length_bl_of_nth [simp]: "length (bl_of_nth n f) = n"
706 lemma nth_bl_of_nth [simp]:
707 "m < n \<Longrightarrow> rev (bl_of_nth n f) ! m = f m"
710 apply (clarsimp simp add : nth_append)
711 apply (rule_tac f = "f" in arg_cong)
716 "(!!k. k < n ==> f k = g k) ==> bl_of_nth n f = bl_of_nth n g"
719 lemma bl_of_nth_nth_le [rule_format] : "ALL xs.
720 length xs >= n --> bl_of_nth n (nth (rev xs)) = drop (length xs - n) xs"
721 apply (induct n, clarsimp)
723 apply (rule trans [OF _ hd_Cons_tl])
724 apply (frule Suc_le_lessD)
725 apply (simp add: nth_rev trans [OF drop_Suc drop_tl, symmetric])
726 apply (subst hd_drop_conv_nth)
729 apply (rule_tac f = "%n. drop n xs" in arg_cong)
733 lemma bl_of_nth_nth [simp]: "bl_of_nth (length xs) (op ! (rev xs)) = xs"
734 by (simp add: bl_of_nth_nth_le)
736 lemma size_rbl_pred: "length (rbl_pred bl) = length bl"
739 lemma size_rbl_succ: "length (rbl_succ bl) = length bl"
743 "!!cl. length (rbl_add bl cl) = length bl"
744 by (induct bl) (auto simp: Let_def size_rbl_succ)
747 "!!cl. length (rbl_mult bl cl) = length bl"
748 by (induct bl) (auto simp add : Let_def size_rbl_add)
750 lemmas rbl_sizes [simp] =
751 size_rbl_pred size_rbl_succ size_rbl_add size_rbl_mult
754 rbl_pred.Nil rbl_succ.Nil rbl_add.Nil rbl_mult.Nil
757 "!!bin. rbl_pred (rev (bin_to_bl n bin)) = rev (bin_to_bl n (Int.pred bin))"
758 apply (induct n, simp)
759 apply (unfold bin_to_bl_def)
761 apply (case_tac bin rule: bin_exhaust)
763 apply (clarsimp simp: bin_to_bl_aux_alt BIT_simps)+
767 "!!bin. rbl_succ (rev (bin_to_bl n bin)) = rev (bin_to_bl n (Int.succ bin))"
768 apply (induct n, simp)
769 apply (unfold bin_to_bl_def)
771 apply (case_tac bin rule: bin_exhaust)
773 apply (clarsimp simp: bin_to_bl_aux_alt BIT_simps)+
777 "!!bina binb. rbl_add (rev (bin_to_bl n bina)) (rev (bin_to_bl n binb)) =
778 rev (bin_to_bl n (bina + binb))"
779 apply (induct n, simp)
780 apply (unfold bin_to_bl_def)
782 apply (case_tac bina rule: bin_exhaust)
783 apply (case_tac binb rule: bin_exhaust)
785 apply (case_tac [!] "ba")
786 apply (auto simp: rbl_succ succ_def bin_to_bl_aux_alt Let_def add_ac BIT_simps)
790 "!!blb. length blb >= length bla ==>
791 rbl_add bla (blb @ blc) = rbl_add bla blb"
792 apply (induct bla, simp)
794 apply (case_tac blb, clarsimp)
795 apply (clarsimp simp: Let_def)
799 "!!blb. length blb >= length bla ==>
800 rbl_add bla (take (length bla) blb) = rbl_add bla blb"
801 apply (induct bla, simp)
803 apply (case_tac blb, clarsimp)
804 apply (clarsimp simp: Let_def)
808 "m >= n ==> rbl_add (rev (bin_to_bl n bina)) (rev (bin_to_bl m binb)) =
809 rev (bin_to_bl n (bina + binb))"
810 apply (rule box_equals [OF _ rbl_add_take2 rbl_add])
811 apply (rule_tac f = "rbl_add (rev (bin_to_bl n bina))" in arg_cong)
812 apply (rule rev_swap [THEN iffD1])
813 apply (simp add: rev_take drop_bin2bl)
818 "!!blb. length blb >= length bla ==>
819 rbl_mult bla (blb @ blc) = rbl_mult bla blb"
820 apply (induct bla, simp)
822 apply (case_tac blb, clarsimp)
823 apply (clarsimp simp: Let_def rbl_add_app2)
826 lemma rbl_mult_take2:
827 "length blb >= length bla ==>
828 rbl_mult bla (take (length bla) blb) = rbl_mult bla blb"
830 apply (rule rbl_mult_app2 [symmetric])
832 apply (rule_tac f = "rbl_mult bla" in arg_cong)
833 apply (rule append_take_drop_id)
837 "m >= length bl ==> rbl_mult bl (rev (bin_to_bl m binb)) =
838 rbl_mult bl (rev (bin_to_bl (length bl) binb))"
840 apply (rule rbl_mult_take2 [symmetric])
842 apply (rule_tac f = "rbl_mult bl" in arg_cong)
843 apply (rule rev_swap [THEN iffD1])
844 apply (simp add: rev_take drop_bin2bl)
848 "m > n ==> rbl_mult (rev (bin_to_bl n bina)) (rev (bin_to_bl m binb)) =
849 rbl_mult (rev (bin_to_bl n bina)) (rev (bin_to_bl n binb))"
850 by (auto intro: trans [OF rbl_mult_gt1])
852 lemmas rbl_mult_Suc = lessI [THEN rbl_mult_gt]
855 "b # rev (bin_to_bl n x) = rev (bin_to_bl (Suc n) (x BIT If b 1 0))"
856 apply (unfold bin_to_bl_def)
858 apply (simp add: bin_to_bl_aux_alt)
861 lemma rbl_mult: "!!bina binb.
862 rbl_mult (rev (bin_to_bl n bina)) (rev (bin_to_bl n binb)) =
863 rev (bin_to_bl n (bina * binb))"
866 apply (unfold bin_to_bl_def)
868 apply (case_tac bina rule: bin_exhaust)
869 apply (case_tac binb rule: bin_exhaust)
871 apply (case_tac [!] "ba")
872 apply (auto simp: bin_to_bl_aux_alt Let_def BIT_simps)
873 apply (auto simp: rbbl_Cons rbl_mult_Suc rbl_add BIT_simps)
877 "P (rbl_add (y # ys) (x # xs)) =
878 (ALL ws. length ws = length ys --> ws = rbl_add ys xs -->
879 (y --> ((x --> P (False # rbl_succ ws)) & (~ x --> P (True # ws)))) &
880 (~ y --> P (x # ws)))"
881 apply (auto simp add: Let_def)
882 apply (case_tac [!] "y")
886 lemma rbl_mult_split:
887 "P (rbl_mult (y # ys) xs) =
888 (ALL ws. length ws = Suc (length ys) --> ws = False # rbl_mult ys xs -->
889 (y --> P (rbl_add ws xs)) & (~ y --> P ws))"
890 by (clarsimp simp add : Let_def)
892 lemma and_len: "xs = ys ==> xs = ys & length xs = length ys"
895 lemma size_if: "size (if p then xs else ys) = (if p then size xs else size ys)"
898 lemma tl_if: "tl (if p then xs else ys) = (if p then tl xs else tl ys)"
901 lemma hd_if: "hd (if p then xs else ys) = (if p then hd xs else hd ys)"
904 lemma if_Not_x: "(if p then ~ x else x) = (p = (~ x))"
907 lemma if_x_Not: "(if p then x else ~ x) = (p = x)"
910 lemma if_same_and: "(If p x y & If p u v) = (if p then x & u else y & v)"
913 lemma if_same_eq: "(If p x y = (If p u v)) = (if p then x = (u) else y = (v))"
916 lemma if_same_eq_not:
917 "(If p x y = (~ If p u v)) = (if p then x = (~u) else y = (~v))"
920 (* note - if_Cons can cause blowup in the size, if p is complex,
922 lemma if_Cons: "(if p then x # xs else y # ys) = If p x y # If p xs ys"
926 "(if xc then [xab] else [an]) = [if xc then xab else an]"
930 "If p True y = (p | y) & If p False y = (~p & y) &
931 If p y True = (p --> y) & If p y False = (p & y)"
934 lemmas if_simps = if_x_Not if_Not_x if_cancel if_True if_False if_bool_simps
936 lemmas seqr = eq_reflection [where x = "size w"] for w (* FIXME: delete *)
938 (* TODO: move name bindings to List.thy *)
939 lemmas tl_Nil = tl.simps (1)
940 lemmas tl_Cons = tl.simps (2)
943 subsection "Repeated splitting or concatenation"
946 "size (concat (map (bin_to_bl n) xs)) = length xs * n"
949 lemma bin_cat_foldl_lem [rule_format] :
950 "ALL x. foldl (%u. bin_cat u n) x xs =
951 bin_cat x (size xs * n) (foldl (%u. bin_cat u n) y xs)"
955 apply (simp (no_asm))
959 apply (drule_tac x = "bin_cat y n a" in spec)
960 apply (simp add : bin_cat_assoc_sym min_max.inf_absorb2)
964 "(bin_rcat n wl) = bl_to_bin (concat (map (bin_to_bl n) wl))"
965 apply (unfold bin_rcat_def)
968 apply (auto simp add : bl_to_bin_append)
969 apply (simp add : bl_to_bin_aux_alt sclem)
970 apply (simp add : bin_cat_foldl_lem [symmetric])
973 lemmas bin_rsplit_aux_simps = bin_rsplit_aux.simps bin_rsplitl_aux.simps
974 lemmas rsplit_aux_simps = bin_rsplit_aux_simps
976 lemmas th_if_simp1 = split_if [where P = "op = l", THEN iffD1, THEN conjunct1, THEN mp] for l
977 lemmas th_if_simp2 = split_if [where P = "op = l", THEN iffD1, THEN conjunct2, THEN mp] for l
979 lemmas rsplit_aux_simp1s = rsplit_aux_simps [THEN th_if_simp1]
981 lemmas rsplit_aux_simp2ls = rsplit_aux_simps [THEN th_if_simp2]
982 (* these safe to [simp add] as require calculating m - n *)
983 lemmas bin_rsplit_aux_simp2s [simp] = rsplit_aux_simp2ls [unfolded Let_def]
984 lemmas rbscl = bin_rsplit_aux_simp2s (2)
986 lemmas rsplit_aux_0_simps [simp] =
987 rsplit_aux_simp1s [OF disjI1] rsplit_aux_simp1s [OF disjI2]
989 lemma bin_rsplit_aux_append:
990 "bin_rsplit_aux n m c (bs @ cs) = bin_rsplit_aux n m c bs @ cs"
991 apply (induct n m c bs rule: bin_rsplit_aux.induct)
992 apply (subst bin_rsplit_aux.simps)
993 apply (subst bin_rsplit_aux.simps)
994 apply (clarsimp split: ls_splits)
998 lemma bin_rsplitl_aux_append:
999 "bin_rsplitl_aux n m c (bs @ cs) = bin_rsplitl_aux n m c bs @ cs"
1000 apply (induct n m c bs rule: bin_rsplitl_aux.induct)
1001 apply (subst bin_rsplitl_aux.simps)
1002 apply (subst bin_rsplitl_aux.simps)
1003 apply (clarsimp split: ls_splits)
1007 lemmas rsplit_aux_apps [where bs = "[]"] =
1008 bin_rsplit_aux_append bin_rsplitl_aux_append
1010 lemmas rsplit_def_auxs = bin_rsplit_def bin_rsplitl_def
1012 lemmas rsplit_aux_alts = rsplit_aux_apps
1013 [unfolded append_Nil rsplit_def_auxs [symmetric]]
1015 lemma bin_split_minus: "0 < n ==> bin_split (Suc (n - 1)) w = bin_split n w"
1018 lemmas bin_split_minus_simp =
1019 bin_split.Suc [THEN [2] bin_split_minus [symmetric, THEN trans]]
1021 lemma bin_split_pred_simp [simp]:
1022 "(0::nat) < number_of bin \<Longrightarrow>
1023 bin_split (number_of bin) w =
1024 (let (w1, w2) = bin_split (number_of (Int.pred bin)) (bin_rest w)
1025 in (w1, w2 BIT bin_last w))"
1026 by (simp only: nobm1 bin_split_minus_simp)
1028 lemma bin_rsplit_aux_simp_alt:
1029 "bin_rsplit_aux n m c bs =
1030 (if m = 0 \<or> n = 0
1032 else let (a, b) = bin_split n c in bin_rsplit n (m - n, a) @ b # bs)"
1033 unfolding bin_rsplit_aux.simps [of n m c bs]
1035 apply (subst rsplit_aux_alts)
1036 apply (simp add: bin_rsplit_def)
1039 lemmas bin_rsplit_simp_alt =
1040 trans [OF bin_rsplit_def bin_rsplit_aux_simp_alt]
1042 lemmas bthrs = bin_rsplit_simp_alt [THEN [2] trans]
1044 lemma bin_rsplit_size_sign' [rule_format] :
1045 "n > 0 ==> (ALL nw w. rev sw = bin_rsplit n (nw, w) -->
1046 (ALL v: set sw. bintrunc n v = v))"
1051 apply (simp (no_asm_use) add: Let_def split: ls_splits)
1053 apply (erule impE, rule exI, erule exI)
1054 apply (drule split_bintrunc)
1058 lemmas bin_rsplit_size_sign = bin_rsplit_size_sign' [OF asm_rl
1059 rev_rev_ident [THEN trans] set_rev [THEN equalityD2 [THEN subsetD]]]
1061 lemma bin_nth_rsplit [rule_format] :
1062 "n > 0 ==> m < n ==> (ALL w k nw. rev sw = bin_rsplit n (nw, w) -->
1063 k < size sw --> bin_nth (sw ! k) m = bin_nth w (k * n + m))"
1068 apply (simp (no_asm_use) add: Let_def split: ls_splits)
1070 apply (erule allE, erule impE, erule exI)
1076 apply (erule (1) impE)
1077 apply (drule bin_nth_split, erule conjE, erule allE,
1078 erule trans, simp add : add_ac)+
1081 lemma bin_rsplit_all:
1082 "0 < nw ==> nw <= n ==> bin_rsplit n (nw, w) = [bintrunc n w]"
1083 unfolding bin_rsplit_def
1084 by (clarsimp dest!: split_bintrunc simp: rsplit_aux_simp2ls split: ls_splits)
1086 lemma bin_rsplit_l [rule_format] :
1087 "ALL bin. bin_rsplitl n (m, bin) = bin_rsplit n (m, bintrunc m bin)"
1088 apply (rule_tac a = "m" in wf_less_than [THEN wf_induct])
1089 apply (simp (no_asm) add : bin_rsplitl_def bin_rsplit_def)
1091 apply (subst bin_rsplitl_aux.simps)
1092 apply (subst bin_rsplit_aux.simps)
1093 apply (clarsimp simp: Let_def split: ls_splits)
1094 apply (drule bin_split_trunc)
1095 apply (drule sym [THEN trans], assumption)
1096 apply (subst rsplit_aux_alts(1))
1097 apply (subst rsplit_aux_alts(2))
1099 unfolding bin_rsplit_def bin_rsplitl_def
1103 lemma bin_rsplit_rcat [rule_format] :
1104 "n > 0 --> bin_rsplit n (n * size ws, bin_rcat n ws) = map (bintrunc n) ws"
1105 apply (unfold bin_rsplit_def bin_rcat_def)
1106 apply (rule_tac xs = "ws" in rev_induct)
1109 apply (subst rsplit_aux_alts)
1110 unfolding bin_split_cat
1114 lemma bin_rsplit_aux_len_le [rule_format] :
1115 "\<forall>ws m. n \<noteq> 0 \<longrightarrow> ws = bin_rsplit_aux n nw w bs \<longrightarrow>
1116 length ws \<le> m \<longleftrightarrow> nw + length bs * n \<le> m * n"
1117 apply (induct n nw w bs rule: bin_rsplit_aux.induct)
1118 apply (subst bin_rsplit_aux.simps)
1119 apply (simp add: lrlem Let_def split: ls_splits)
1122 lemma bin_rsplit_len_le:
1123 "n \<noteq> 0 --> ws = bin_rsplit n (nw, w) --> (length ws <= m) = (nw <= m * n)"
1124 unfolding bin_rsplit_def by (clarsimp simp add : bin_rsplit_aux_len_le)
1126 lemma bin_rsplit_aux_len [rule_format] :
1127 "n\<noteq>0 --> length (bin_rsplit_aux n nw w cs) =
1128 (nw + n - 1) div n + length cs"
1129 apply (induct n nw w cs rule: bin_rsplit_aux.induct)
1130 apply (subst bin_rsplit_aux.simps)
1131 apply (clarsimp simp: Let_def split: ls_splits)
1132 apply (erule thin_rl)
1135 apply (case_tac "m <= n")
1139 lemma bin_rsplit_len:
1140 "n\<noteq>0 ==> length (bin_rsplit n (nw, w)) = (nw + n - 1) div n"
1141 unfolding bin_rsplit_def by (clarsimp simp add : bin_rsplit_aux_len)
1143 lemma bin_rsplit_aux_len_indep:
1144 "n \<noteq> 0 \<Longrightarrow> length bs = length cs \<Longrightarrow>
1145 length (bin_rsplit_aux n nw v bs) =
1146 length (bin_rsplit_aux n nw w cs)"
1147 proof (induct n nw w cs arbitrary: v bs rule: bin_rsplit_aux.induct)
1148 case (1 n m w cs v bs) show ?case
1149 proof (cases "m = 0")
1150 case True then show ?thesis using `length bs = length cs` by simp
1153 from "1.hyps" `m \<noteq> 0` `n \<noteq> 0` have hyp: "\<And>v bs. length bs = Suc (length cs) \<Longrightarrow>
1154 length (bin_rsplit_aux n (m - n) v bs) =
1155 length (bin_rsplit_aux n (m - n) (fst (bin_split n w)) (snd (bin_split n w) # cs))"
1157 show ?thesis using `length bs = length cs` `n \<noteq> 0`
1158 by (auto simp add: bin_rsplit_aux_simp_alt Let_def bin_rsplit_len
1163 lemma bin_rsplit_len_indep:
1164 "n\<noteq>0 ==> length (bin_rsplit n (nw, v)) = length (bin_rsplit n (nw, w))"
1165 apply (unfold bin_rsplit_def)
1166 apply (simp (no_asm))
1167 apply (erule bin_rsplit_aux_len_indep)