src/HOL/Word/Bool_List_Representation.thy
author huffman
Tue, 27 Dec 2011 12:05:03 +0100
changeset 46867 e69d631fe9af
parent 46725 40554613b4f0
child 46868 13392893ea12
permissions -rw-r--r--
declare simp rules immediately, instead of using 'declare' commands
     1 (* 
     2   Author: Jeremy Dawson, NICTA
     3 
     4   Theorems to do with integers, expressed using Pls, Min, BIT,
     5   theorems linking them to lists of booleans, and repeated splitting 
     6   and concatenation.
     7 *) 
     8 
     9 header "Bool lists and integers"
    10 
    11 theory Bool_List_Representation
    12 imports Bit_Int
    13 begin
    14 
    15 subsection {* Operations on lists of booleans *}
    16 
    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))"
    21 
    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"
    24 
    25 lemma [code]:
    26   "bl_to_bin bs = bl_to_bin_aux bs 0"
    27   by (simp add: bl_to_bin_def Pls_def)
    28 
    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)"
    33 
    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 []"
    36 
    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 = []"
    40 
    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)"
    46 
    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)"
    49 
    50 lemma map2_Nil [simp]: "map2 f [] ys = []"
    51   unfolding map2_def by auto
    52 
    53 lemma map2_Nil2 [simp]: "map2 f xs [] = []"
    54   unfolding map2_def by auto
    55 
    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
    59 
    60 
    61 subsection "Arithmetic in terms of bool lists"
    62 
    63 text {* 
    64   Arithmetic operations in terms of the reversed bool list,
    65   assuming input list(s) the same length, and don't extend them. 
    66 *}
    67 
    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)"
    71 
    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)"
    75 
    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))"
    81 
    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)"
    87 
    88 lemma butlast_power:
    89   "(butlast ^^ n) bl = take (length bl - n) bl"
    90   by (induct n) (auto simp: butlast_take)
    91 
    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)"
    95   by (cases n) auto
    96 
    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)"
   100   by (cases n) auto
   101 
   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)"
   105   by (cases n) auto
   106 
   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)"
   110   by (cases n) auto
   111 
   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)"
   115   by (cases n) auto
   116 
   117 text {* Link between bin and bool list. *}
   118 
   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
   122 
   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
   126 
   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)
   130 
   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)
   134 
   135 lemma bin_to_bl_0 [simp]: "bin_to_bl 0 bs = []"
   136   unfolding bin_to_bl_def by auto
   137 
   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
   141 
   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)
   144 
   145 lemma bin_bl_bin': 
   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)
   149 
   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
   152 
   153 lemma bl_bin_bl':
   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)
   157    apply auto
   158     apply (simp_all only : add_Suc [symmetric])
   159     apply (auto simp add : bin_to_bl_def)
   160   done
   161 
   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')
   166    prefer 2
   167    apply (rule bin_to_bl_aux.Z)
   168   apply simp
   169   done
   170   
   171 lemma bl_to_bin_inj:
   172   "bl_to_bin bs = bl_to_bin cs ==> length bs = length cs ==> bs = cs"
   173   apply (rule_tac box_equals)
   174     defer
   175     apply (rule bl_bin_bl)
   176    apply (rule bl_bin_bl)
   177   apply simp
   178   done
   179 
   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)
   182 
   183 lemma bl_to_bin_Nil [simp]: "bl_to_bin [] = Int.Pls"
   184   unfolding bl_to_bin_def by auto
   185 
   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)
   189 
   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)
   192 
   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)
   196 
   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)
   199 
   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)
   204   done
   205 
   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)
   209 
   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"
   213   apply (induct n)
   214    apply clarsimp
   215   apply clarsimp
   216   apply (case_tac "m")
   217    apply (clarsimp simp: bin_to_bl_Pls_aux) 
   218    apply (erule thin_rl)
   219    apply (induct_tac n)   
   220     apply auto
   221   done
   222 
   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)
   227 
   228 lemma bl_to_bin_rep_False: "bl_to_bin (replicate n False) = Int.Pls"
   229   by (induct n) auto
   230 
   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
   234 
   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
   237   
   238 lemma sign_bl_bin': 
   239   "bin_sign (bl_to_bin_aux bs w) = bin_sign w"
   240   by (induct bs arbitrary: w) auto
   241   
   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')
   244   
   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)
   249    apply clarsimp
   250    apply (cases w rule: bin_exhaust)
   251    apply (simp split add : bit.split)
   252   apply clarsimp
   253   done
   254     
   255 lemma bl_sbin_sign: 
   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)
   258 
   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)
   263    apply clarsimp
   264   apply clarsimp
   265   apply (cut_tac x=n and y="size list" in linorder_less_linear)
   266   apply (erule disjE, simp add: nth_append)+
   267   apply auto
   268   done
   269 
   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)
   272 
   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"
   275   apply (induct n)
   276    apply clarsimp
   277    apply (case_tac m, clarsimp)
   278    apply (clarsimp simp: bin_to_bl_def)
   279    apply (simp add: bin_to_bl_aux_alt)
   280   apply clarsimp
   281   apply (case_tac m, clarsimp)
   282   apply (clarsimp simp: bin_to_bl_def)
   283   apply (simp add: bin_to_bl_aux_alt)
   284   done
   285 
   286 lemma nth_rev [rule_format] : 
   287   "n < length xs --> rev xs ! n = xs ! (length xs - 1 - n)"
   288   apply (induct_tac "xs")
   289    apply simp
   290   apply (clarsimp simp add : nth_append nth.simps split add : nat.split)
   291   apply (rule_tac f = "%n. list ! n" in arg_cong) 
   292   apply arith
   293   done
   294 
   295 lemma nth_rev_alt: "n < length ys \<Longrightarrow> ys ! n = rev ys ! (length ys - Suc n)"
   296   by (simp add: nth_rev)
   297 
   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))"
   301   apply (induct m)
   302    apply clarsimp
   303   apply clarsimp
   304   apply (case_tac w rule: bin_exhaust)
   305   apply simp
   306   done
   307   
   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)
   310 
   311 lemma bl_to_bin_lt2p_aux [rule_format]: 
   312   "\<forall>w. bl_to_bin_aux bs w < (w + 1) * (2 ^ length bs)"
   313   apply (induct bs)
   314    apply clarsimp
   315   apply clarsimp
   316   apply safe
   317   apply (erule allE, erule xtr8 [rotated],
   318          simp add: numeral_simps algebra_simps BIT_simps
   319          cong add: number_of_False_cong)+
   320   done
   321 
   322 lemma bl_to_bin_lt2p: "bl_to_bin bs < (2 ^ length bs)"
   323   apply (unfold bl_to_bin_def)
   324   apply (rule xtr1)
   325    prefer 2
   326    apply (rule bl_to_bin_lt2p_aux)
   327   apply simp
   328   done
   329 
   330 lemma bl_to_bin_ge2p_aux [rule_format] : 
   331   "\<forall>w. bl_to_bin_aux bs w >= w * (2 ^ length bs)"
   332   apply (induct bs)
   333    apply clarsimp
   334   apply clarsimp
   335   apply safe
   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)+
   339   done
   340 
   341 lemma bl_to_bin_ge0: "bl_to_bin bs >= 0"
   342   apply (unfold bl_to_bin_def)
   343   apply (rule xtr4)
   344    apply (rule bl_to_bin_ge2p_aux)
   345   apply (simp add: Pls_def)
   346   done
   347 
   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)
   353   apply clarsimp
   354   apply (auto simp add: bin_to_bl_aux_alt)
   355   done
   356 
   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
   360 
   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
   365   
   366 lemma butlast_rest_bl2bin: 
   367   "bl_to_bin (butlast bl) = bin_rest (bl_to_bin bl)"
   368   apply (unfold bl_to_bin_def)
   369   apply (cases bl)
   370    apply (auto simp add: butlast_rest_bl2bin_aux)
   371   done
   372 
   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)
   377    apply clarsimp
   378   apply clarsimp
   379   apply safe
   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))" 
   384                    in arg_cong) 
   385    apply simp
   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))" 
   390                   in arg_cong) 
   391   apply simp
   392   done
   393 
   394 lemma trunc_bl2bin: 
   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)
   397   
   398 lemma trunc_bl2bin_len [simp]:
   399   "bintrunc (length bl) (bl_to_bin bl) = bl_to_bin bl"
   400   by (simp add: trunc_bl2bin)
   401 
   402 lemma bl2bin_drop: 
   403   "bl_to_bin (drop k bl) = bintrunc (length bl - k) (bl_to_bin bl)"
   404   apply (rule trans)
   405    prefer 2
   406    apply (rule trunc_bl2bin [symmetric])
   407   apply (cases "k <= length bl")
   408    apply auto
   409   done
   410 
   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)
   414   apply clarsimp
   415   apply (simp only: bin_nth.Suc [symmetric] add_Suc)
   416   done
   417 
   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)
   421    apply simp
   422   apply (clarsimp simp add: nth_bin_to_bl nth_rest_power_bin)
   423   done
   424 
   425 lemma hd_butlast: "size xs > 1 ==> hd (butlast xs) = hd xs"
   426   by (cases xs) auto
   427 
   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
   431 
   432 lemma last_bin_last: 
   433   "size xs > 0 ==> last xs = (bin_last (bl_to_bin xs) = 1)" 
   434   unfolding bl_to_bin_def by (erule last_bin_last')
   435   
   436 lemma bin_last_last: 
   437   "bin_last w = (if last (bin_to_bl (Suc n) w) then 1 else 0)" 
   438   apply (unfold bin_to_bl_def)
   439   apply simp
   440   apply (auto simp add: bin_to_bl_aux_alt)
   441   done
   442 
   443 (** links between bit-wise operations and operations on bool lists **)
   444     
   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)"
   448   apply (induct_tac n)
   449    apply safe
   450    apply simp
   451   apply (case_tac v rule: bin_exhaust)
   452   apply (case_tac w rule: bin_exhaust)
   453   apply clarsimp
   454   apply (case_tac b)
   455   apply (case_tac ba, safe, simp_all)+
   456   done
   457     
   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)" 
   461   apply (induct_tac n)
   462    apply safe
   463    apply simp
   464   apply (case_tac v rule: bin_exhaust)
   465   apply (case_tac w rule: bin_exhaust)
   466   apply clarsimp
   467   apply (case_tac b)
   468   apply (case_tac ba, safe, simp_all)+
   469   done
   470     
   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)" 
   474   apply (induct_tac n)
   475    apply safe
   476    apply simp
   477   apply (case_tac v rule: bin_exhaust)
   478   apply (case_tac w rule: bin_exhaust)
   479   apply clarsimp
   480   done
   481     
   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)"
   485   apply (induct n)
   486    apply clarsimp
   487   apply clarsimp
   488   done
   489 
   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)
   492 
   493 lemma bl_and_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)
   496 
   497 lemma bl_or_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)
   500 
   501 lemma bl_xor_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)
   504 
   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)
   509   apply clarsimp
   510   apply (case_tac bin rule: bin_exhaust)
   511   apply (case_tac "m <= n", simp)
   512   apply (case_tac "m - n", simp)
   513   apply simp
   514   apply (rule_tac f = "%nat. drop nat bs" in arg_cong) 
   515   apply simp
   516   done
   517 
   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)
   520 
   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)
   524   apply 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)
   528   done
   529 
   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)"
   533   apply (induct n)
   534    apply clarify
   535    apply (simp_all (no_asm) add: bin_to_bl_def take_bin2bl_lem1)
   536   apply simp
   537   done
   538 
   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)"
   542   apply (induct n)
   543    apply clarsimp
   544   apply (clarsimp simp: Let_def split: ls_splits)
   545   apply (simp add: bin_to_bl_def)
   546   apply (simp add: take_bin2bl_lem)
   547   done
   548 
   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)
   553   
   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)
   557   apply clarsimp
   558   apply (case_tac m)
   559    apply (simp split: list.split)
   560   apply clarsimp
   561   apply (erule allE)+
   562   apply (erule (1) impE)
   563   apply (simp split: list.split)
   564   done
   565 
   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)
   569 
   570 lemma takefill_replicate [simp]:
   571   "takefill fill n (replicate m fill) = replicate n fill"
   572   by (simp add : takefill_alt replicate_add [symmetric])
   573 
   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)
   577 
   578 lemma length_takefill [simp]: "length (takefill fill n l) = n"
   579   by (simp add : takefill_alt)
   580 
   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) 
   584 
   585 lemma drop_takefill:
   586   "!!w. drop k (takefill fill (m + k) w) = takefill fill m (drop k w)"
   587   by (induct k) (auto split add : list.split) 
   588 
   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')
   592 
   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')
   596  
   597 lemma takefill_append:
   598   "takefill fill (m + length xs) (xs @ w) = xs @ (takefill fill m w)"
   599   by (induct xs) auto
   600 
   601 lemma takefill_same': 
   602   "l = length xs ==> takefill fill l xs = xs"
   603   by clarify (induct xs, auto)
   604  
   605 lemmas takefill_same [simp] = takefill_same' [OF refl]
   606 
   607 lemma takefill_bintrunc:
   608   "takefill False n bl = rev (bin_to_bl n (bl_to_bin (rev bl)))"
   609   apply (rule nth_equalityI)
   610    apply simp
   611   apply (clarsimp simp: nth_takefill nth_rev nth_bin_to_bl bin_nth_of_bl)
   612   done
   613 
   614 lemma bl_bin_bl_rtf:
   615   "bin_to_bl n (bl_to_bin bl) = rev (takefill False n (rev bl))"
   616   by (simp add : takefill_bintrunc)
   617 
   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)
   622 
   623 lemma tf_rev:
   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) 
   629   apply arith 
   630   done
   631 
   632 lemma takefill_minus:
   633   "0 < n ==> takefill fill (Suc (n - 1)) w = takefill fill n w"
   634   by auto
   635 
   636 lemmas takefill_Suc_cases = 
   637   list.cases [THEN takefill.Suc [THEN trans]]
   638 
   639 lemmas takefill_Suc_Nil = takefill_Suc_cases (1)
   640 lemmas takefill_Suc_Cons = takefill_Suc_cases (2)
   641 
   642 lemmas takefill_minus_simps = takefill_Suc_cases [THEN [2] 
   643   takefill_minus [symmetric, THEN trans]]
   644 
   645 lemmas takefill_pred_simps [simp] =
   646   takefill_minus_simps [where n="number_of bin", simplified nobm1] for bin
   647 
   648 (* links with function bl_to_bin *)
   649 
   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)"
   653   apply (induct bs)
   654    apply simp
   655   apply (simp add: bin_cat_Suc_Bit [symmetric] del: bin_cat.simps)
   656   done
   657 
   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)"
   661   by (induct nw) auto 
   662 
   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
   667 
   668 lemma bin_to_bl_cat:
   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)
   672 
   673 lemmas bl_to_bin_aux_app_cat = 
   674   trans [OF bl_to_bin_aux_append bl_to_bin_aux_alt]
   675 
   676 lemmas bin_to_bl_aux_cat_app =
   677   trans [OF bin_to_bl_aux_cat bin_to_bl_aux_alt]
   678 
   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)
   682 
   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)
   686 
   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)
   691 
   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)
   695   apply (induct n)
   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)
   700   done
   701 
   702 (* function bl_of_nth *)
   703 lemma length_bl_of_nth [simp]: "length (bl_of_nth n f) = n"
   704   by (induct n)  auto
   705 
   706 lemma nth_bl_of_nth [simp]:
   707   "m < n \<Longrightarrow> rev (bl_of_nth n f) ! m = f m"
   708   apply (induct n)
   709    apply simp
   710   apply (clarsimp simp add : nth_append)
   711   apply (rule_tac f = "f" in arg_cong) 
   712   apply simp
   713   done
   714 
   715 lemma bl_of_nth_inj: 
   716   "(!!k. k < n ==> f k = g k) ==> bl_of_nth n f = bl_of_nth n g"
   717   by (induct n)  auto
   718 
   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)
   722   apply 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)
   727      apply force
   728     apply simp_all
   729   apply (rule_tac f = "%n. drop n xs" in arg_cong) 
   730   apply simp
   731   done
   732 
   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)
   735 
   736 lemma size_rbl_pred: "length (rbl_pred bl) = length bl"
   737   by (induct bl) auto
   738 
   739 lemma size_rbl_succ: "length (rbl_succ bl) = length bl"
   740   by (induct bl) auto
   741 
   742 lemma size_rbl_add:
   743   "!!cl. length (rbl_add bl cl) = length bl"
   744   by (induct bl) (auto simp: Let_def size_rbl_succ)
   745 
   746 lemma size_rbl_mult: 
   747   "!!cl. length (rbl_mult bl cl) = length bl"
   748   by (induct bl) (auto simp add : Let_def size_rbl_add)
   749 
   750 lemmas rbl_sizes [simp] = 
   751   size_rbl_pred size_rbl_succ size_rbl_add size_rbl_mult
   752 
   753 lemmas rbl_Nils =
   754   rbl_pred.Nil rbl_succ.Nil rbl_add.Nil rbl_mult.Nil
   755 
   756 lemma rbl_pred: 
   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)
   760   apply clarsimp
   761   apply (case_tac bin rule: bin_exhaust)
   762   apply (case_tac b)
   763    apply (clarsimp simp: bin_to_bl_aux_alt BIT_simps)+
   764   done
   765 
   766 lemma rbl_succ: 
   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)
   770   apply clarsimp
   771   apply (case_tac bin rule: bin_exhaust)
   772   apply (case_tac b)
   773    apply (clarsimp simp: bin_to_bl_aux_alt BIT_simps)+
   774   done
   775 
   776 lemma rbl_add: 
   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)
   781   apply clarsimp
   782   apply (case_tac bina rule: bin_exhaust)
   783   apply (case_tac binb rule: bin_exhaust)
   784   apply (case_tac b)
   785    apply (case_tac [!] "ba")
   786      apply (auto simp: rbl_succ succ_def bin_to_bl_aux_alt Let_def add_ac BIT_simps)
   787   done
   788 
   789 lemma rbl_add_app2: 
   790   "!!blb. length blb >= length bla ==> 
   791     rbl_add bla (blb @ blc) = rbl_add bla blb"
   792   apply (induct bla, simp)
   793   apply clarsimp
   794   apply (case_tac blb, clarsimp)
   795   apply (clarsimp simp: Let_def)
   796   done
   797 
   798 lemma rbl_add_take2: 
   799   "!!blb. length blb >= length bla ==> 
   800     rbl_add bla (take (length bla) blb) = rbl_add bla blb"
   801   apply (induct bla, simp)
   802   apply clarsimp
   803   apply (case_tac blb, clarsimp)
   804   apply (clarsimp simp: Let_def)
   805   done
   806 
   807 lemma rbl_add_long: 
   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)
   814   apply simp
   815   done
   816 
   817 lemma rbl_mult_app2:
   818   "!!blb. length blb >= length bla ==> 
   819     rbl_mult bla (blb @ blc) = rbl_mult bla blb"
   820   apply (induct bla, simp)
   821   apply clarsimp
   822   apply (case_tac blb, clarsimp)
   823   apply (clarsimp simp: Let_def rbl_add_app2)
   824   done
   825 
   826 lemma rbl_mult_take2: 
   827   "length blb >= length bla ==> 
   828     rbl_mult bla (take (length bla) blb) = rbl_mult bla blb"
   829   apply (rule trans)
   830    apply (rule rbl_mult_app2 [symmetric])
   831    apply simp
   832   apply (rule_tac f = "rbl_mult bla" in arg_cong) 
   833   apply (rule append_take_drop_id)
   834   done
   835     
   836 lemma rbl_mult_gt1: 
   837   "m >= length bl ==> rbl_mult bl (rev (bin_to_bl m binb)) = 
   838     rbl_mult bl (rev (bin_to_bl (length bl) binb))"
   839   apply (rule trans)
   840    apply (rule rbl_mult_take2 [symmetric])
   841    apply simp_all
   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)
   845   done
   846     
   847 lemma rbl_mult_gt: 
   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])
   851   
   852 lemmas rbl_mult_Suc = lessI [THEN rbl_mult_gt]
   853 
   854 lemma rbbl_Cons: 
   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)
   857   apply simp
   858   apply (simp add: bin_to_bl_aux_alt)
   859   done
   860   
   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))"
   864   apply (induct n)
   865    apply simp
   866   apply (unfold bin_to_bl_def)
   867   apply clarsimp
   868   apply (case_tac bina rule: bin_exhaust)
   869   apply (case_tac binb rule: bin_exhaust)
   870   apply (case_tac b)
   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)
   874   done
   875 
   876 lemma rbl_add_split: 
   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")
   883      apply auto
   884   done
   885 
   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)
   891   
   892 lemma and_len: "xs = ys ==> xs = ys & length xs = length ys"
   893   by auto
   894 
   895 lemma size_if: "size (if p then xs else ys) = (if p then size xs else size ys)"
   896   by auto
   897 
   898 lemma tl_if: "tl (if p then xs else ys) = (if p then tl xs else tl ys)"
   899   by auto
   900 
   901 lemma hd_if: "hd (if p then xs else ys) = (if p then hd xs else hd ys)"
   902   by auto
   903 
   904 lemma if_Not_x: "(if p then ~ x else x) = (p = (~ x))"
   905   by auto
   906 
   907 lemma if_x_Not: "(if p then x else ~ x) = (p = x)"
   908   by auto
   909 
   910 lemma if_same_and: "(If p x y & If p u v) = (if p then x & u else y & v)"
   911   by auto
   912 
   913 lemma if_same_eq: "(If p x y  = (If p u v)) = (if p then x = (u) else y = (v))"
   914   by auto
   915 
   916 lemma if_same_eq_not:
   917   "(If p x y  = (~ If p u v)) = (if p then x = (~u) else y = (~v))"
   918   by auto
   919 
   920 (* note - if_Cons can cause blowup in the size, if p is complex,
   921   so make a simproc *)
   922 lemma if_Cons: "(if p then x # xs else y # ys) = If p x y # If p xs ys"
   923   by auto
   924 
   925 lemma if_single:
   926   "(if xc then [xab] else [an]) = [if xc then xab else an]"
   927   by auto
   928 
   929 lemma if_bool_simps:
   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)"
   932   by auto
   933 
   934 lemmas if_simps = if_x_Not if_Not_x if_cancel if_True if_False if_bool_simps
   935 
   936 lemmas seqr = eq_reflection [where x = "size w"] for w (* FIXME: delete *)
   937 
   938 (* TODO: move name bindings to List.thy *)
   939 lemmas tl_Nil = tl.simps (1)
   940 lemmas tl_Cons = tl.simps (2)
   941 
   942 
   943 subsection "Repeated splitting or concatenation"
   944 
   945 lemma sclem:
   946   "size (concat (map (bin_to_bl n) xs)) = length xs * n"
   947   by (induct xs) auto
   948 
   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)"
   952   apply (induct xs)
   953    apply simp
   954   apply clarify
   955   apply (simp (no_asm))
   956   apply (frule asm_rl)
   957   apply (drule spec)
   958   apply (erule trans)
   959   apply (drule_tac x = "bin_cat y n a" in spec)
   960   apply (simp add : bin_cat_assoc_sym min_max.inf_absorb2)
   961   done
   962 
   963 lemma bin_rcat_bl:
   964   "(bin_rcat n wl) = bl_to_bin (concat (map (bin_to_bl n) wl))"
   965   apply (unfold bin_rcat_def)
   966   apply (rule sym)
   967   apply (induct wl)
   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])
   971   done
   972 
   973 lemmas bin_rsplit_aux_simps = bin_rsplit_aux.simps bin_rsplitl_aux.simps
   974 lemmas rsplit_aux_simps = bin_rsplit_aux_simps
   975 
   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
   978 
   979 lemmas rsplit_aux_simp1s = rsplit_aux_simps [THEN th_if_simp1]
   980 
   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)
   985 
   986 lemmas rsplit_aux_0_simps [simp] = 
   987   rsplit_aux_simp1s [OF disjI1] rsplit_aux_simp1s [OF disjI2]
   988 
   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)
   995   apply auto
   996   done
   997 
   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)
  1004   apply auto
  1005   done
  1006 
  1007 lemmas rsplit_aux_apps [where bs = "[]"] =
  1008   bin_rsplit_aux_append bin_rsplitl_aux_append
  1009 
  1010 lemmas rsplit_def_auxs = bin_rsplit_def bin_rsplitl_def
  1011 
  1012 lemmas rsplit_aux_alts = rsplit_aux_apps 
  1013   [unfolded append_Nil rsplit_def_auxs [symmetric]]
  1014 
  1015 lemma bin_split_minus: "0 < n ==> bin_split (Suc (n - 1)) w = bin_split n w"
  1016   by auto
  1017 
  1018 lemmas bin_split_minus_simp =
  1019   bin_split.Suc [THEN [2] bin_split_minus [symmetric, THEN trans]]
  1020 
  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)
  1027 
  1028 lemma bin_rsplit_aux_simp_alt:
  1029   "bin_rsplit_aux n m c bs =
  1030    (if m = 0 \<or> n = 0 
  1031    then bs
  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]
  1034   apply simp
  1035   apply (subst rsplit_aux_alts)
  1036   apply (simp add: bin_rsplit_def)
  1037   done
  1038 
  1039 lemmas bin_rsplit_simp_alt = 
  1040   trans [OF bin_rsplit_def bin_rsplit_aux_simp_alt]
  1041 
  1042 lemmas bthrs = bin_rsplit_simp_alt [THEN [2] trans]
  1043 
  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))"
  1047   apply (induct sw)
  1048    apply clarsimp
  1049   apply clarsimp
  1050   apply (drule bthrs)
  1051   apply (simp (no_asm_use) add: Let_def split: ls_splits)
  1052   apply clarify
  1053   apply (erule impE, rule exI, erule exI)
  1054   apply (drule split_bintrunc)
  1055   apply simp
  1056   done
  1057 
  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]]]
  1060 
  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))"
  1064   apply (induct sw)
  1065    apply clarsimp
  1066   apply clarsimp
  1067   apply (drule bthrs)
  1068   apply (simp (no_asm_use) add: Let_def split: ls_splits)
  1069   apply clarify
  1070   apply (erule allE, erule impE, erule exI)
  1071   apply (case_tac k)
  1072    apply clarsimp   
  1073    prefer 2
  1074    apply clarsimp
  1075    apply (erule allE)
  1076    apply (erule (1) impE)
  1077    apply (drule bin_nth_split, erule conjE, erule allE,
  1078           erule trans, simp add : add_ac)+
  1079   done
  1080 
  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)
  1085 
  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)
  1090   apply (rule allI)
  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))
  1098   apply clarsimp
  1099   unfolding bin_rsplit_def bin_rsplitl_def
  1100   apply simp
  1101   done
  1102 
  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)
  1107    apply clarsimp
  1108   apply clarsimp
  1109   apply (subst rsplit_aux_alts)
  1110   unfolding bin_split_cat
  1111   apply simp
  1112   done
  1113 
  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)
  1120   done
  1121 
  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)
  1125  
  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)
  1133   apply (case_tac m)
  1134   apply simp
  1135   apply (case_tac "m <= n")
  1136   apply auto
  1137   done
  1138 
  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)
  1142 
  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
  1151   next
  1152     case False
  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))"
  1156     by auto
  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
  1159         split: ls_splits)
  1160   qed
  1161 qed
  1162 
  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)
  1168   apply (rule refl)
  1169   done
  1170 
  1171 end