src/HOL/Word/Bit_Representation.thy
author huffman
Tue, 27 Dec 2011 15:37:33 +0100
changeset 46872 0b562d564d5f
parent 46871 871bdab23f5c
child 46893 fad87bb608fc
child 46895 c296c75f4cf4
permissions -rw-r--r--
redefine some binary operations on integers work on abstract numerals instead of Int.Pls and Int.Min
     1 (* 
     2   Author: Jeremy Dawson, NICTA
     3 
     4   Basic definitions to do with integers, expressed using Pls, Min, BIT.
     5 *) 
     6 
     7 header {* Basic Definitions for Binary Integers *}
     8 
     9 theory Bit_Representation
    10 imports Misc_Numeric "~~/src/HOL/Library/Bit"
    11 begin
    12 
    13 subsection {* Further properties of numerals *}
    14 
    15 definition bitval :: "bit \<Rightarrow> 'a\<Colon>zero_neq_one" where
    16   "bitval = bit_case 0 1"
    17 
    18 lemma bitval_simps [simp]:
    19   "bitval 0 = 0"
    20   "bitval 1 = 1"
    21   by (simp_all add: bitval_def)
    22 
    23 definition Bit :: "int \<Rightarrow> bit \<Rightarrow> int" (infixl "BIT" 90) where
    24   "k BIT b = bitval b + k + k"
    25 
    26 definition bin_last :: "int \<Rightarrow> bit" where
    27   "bin_last w = (if w mod 2 = 0 then (0::bit) else (1::bit))"
    28 
    29 definition bin_rest :: "int \<Rightarrow> int" where
    30   "bin_rest w = w div 2"
    31 
    32 lemma bin_rl_simp [simp]:
    33   "bin_rest w BIT bin_last w = w"
    34   unfolding bin_rest_def bin_last_def Bit_def
    35   using mod_div_equality [of w 2]
    36   by (cases "w mod 2 = 0", simp_all)
    37 
    38 lemma bin_rest_BIT: "bin_rest (x BIT b) = x"
    39   unfolding bin_rest_def Bit_def
    40   by (cases b, simp_all)
    41 
    42 lemma bin_last_BIT: "bin_last (x BIT b) = b"
    43   unfolding bin_last_def Bit_def
    44   by (cases b, simp_all add: z1pmod2)
    45 
    46 lemma BIT_eq_iff [iff]: "u BIT b = v BIT c \<longleftrightarrow> u = v \<and> b = c"
    47   by (metis bin_rest_BIT bin_last_BIT)
    48 
    49 lemma BIT_bin_simps [simp]:
    50   "number_of w BIT 0 = number_of (Int.Bit0 w)"
    51   "number_of w BIT 1 = number_of (Int.Bit1 w)"
    52   unfolding Bit_def number_of_is_id numeral_simps by simp_all
    53 
    54 lemma BIT_special_simps [simp]:
    55   shows "0 BIT 0 = 0" and "0 BIT 1 = 1" and "1 BIT 0 = 2" and "1 BIT 1 = 3"
    56   unfolding Bit_def by simp_all
    57 
    58 lemma bin_last_numeral_simps [simp]:
    59   "bin_last 0 = 0"
    60   "bin_last 1 = 1"
    61   "bin_last -1 = 1"
    62   "bin_last (number_of (Int.Bit0 w)) = 0"
    63   "bin_last (number_of (Int.Bit1 w)) = 1"
    64   unfolding bin_last_def by simp_all
    65 
    66 lemma bin_rest_numeral_simps [simp]:
    67   "bin_rest 0 = 0"
    68   "bin_rest 1 = 0"
    69   "bin_rest -1 = -1"
    70   "bin_rest (number_of (Int.Bit0 w)) = number_of w"
    71   "bin_rest (number_of (Int.Bit1 w)) = number_of w"
    72   unfolding bin_rest_def by simp_all
    73 
    74 lemma BIT_B0_eq_Bit0: "w BIT 0 = Int.Bit0 w"
    75   unfolding Bit_def Bit0_def by simp
    76 
    77 lemma BIT_B1_eq_Bit1: "w BIT 1 = Int.Bit1 w"
    78   unfolding Bit_def Bit1_def by simp
    79 
    80 lemmas BIT_simps = BIT_B0_eq_Bit0 BIT_B1_eq_Bit1
    81 
    82 lemma number_of_False_cong: 
    83   "False \<Longrightarrow> number_of x = number_of y"
    84   by (rule FalseE)
    85 
    86 lemma less_Bits: 
    87   "(v BIT b < w BIT c) = (v < w | v <= w & b = (0::bit) & c = (1::bit))"
    88   unfolding Bit_def by (auto simp add: bitval_def split: bit.split)
    89 
    90 lemma le_Bits: 
    91   "(v BIT b <= w BIT c) = (v < w | v <= w & (b ~= (1::bit) | c ~= (0::bit)))" 
    92   unfolding Bit_def by (auto simp add: bitval_def split: bit.split)
    93 
    94 lemma Bit_B0:
    95   "k BIT (0::bit) = k + k"
    96    by (unfold Bit_def) simp
    97 
    98 lemma Bit_B1:
    99   "k BIT (1::bit) = k + k + 1"
   100    by (unfold Bit_def) simp
   101   
   102 lemma Bit_B0_2t: "k BIT (0::bit) = 2 * k"
   103   by (rule trans, rule Bit_B0) simp
   104 
   105 lemma Bit_B1_2t: "k BIT (1::bit) = 2 * k + 1"
   106   by (rule trans, rule Bit_B1) simp
   107 
   108 lemma B_mod_2': 
   109   "X = 2 ==> (w BIT (1::bit)) mod X = 1 & (w BIT (0::bit)) mod X = 0"
   110   apply (simp (no_asm) only: Bit_B0 Bit_B1)
   111   apply (simp add: z1pmod2)
   112   done
   113 
   114 lemma B1_mod_2 [simp]: "(Int.Bit1 w) mod 2 = 1"
   115   unfolding numeral_simps number_of_is_id by (simp add: z1pmod2)
   116 
   117 lemma B0_mod_2 [simp]: "(Int.Bit0 w) mod 2 = 0"
   118   unfolding numeral_simps number_of_is_id by simp
   119 
   120 lemma neB1E [elim!]:
   121   assumes ne: "y \<noteq> (1::bit)"
   122   assumes y: "y = (0::bit) \<Longrightarrow> P"
   123   shows "P"
   124   apply (rule y)
   125   apply (cases y rule: bit.exhaust, simp)
   126   apply (simp add: ne)
   127   done
   128 
   129 lemma bin_ex_rl: "EX w b. w BIT b = bin"
   130   apply (unfold Bit_def)
   131   apply (cases "even bin")
   132    apply (clarsimp simp: even_equiv_def)
   133    apply (auto simp: odd_equiv_def bitval_def split: bit.split)
   134   done
   135 
   136 lemma bin_exhaust:
   137   assumes Q: "\<And>x b. bin = x BIT b \<Longrightarrow> Q"
   138   shows "Q"
   139   apply (insert bin_ex_rl [of bin])  
   140   apply (erule exE)+
   141   apply (rule Q)
   142   apply force
   143   done
   144 
   145 
   146 subsection {* Destructors for binary integers *}
   147 
   148 definition bin_rl :: "int \<Rightarrow> int \<times> bit" where 
   149   "bin_rl w = (bin_rest w, bin_last w)"
   150 
   151 lemma bin_rl_char: "bin_rl w = (r, l) \<longleftrightarrow> r BIT l = w"
   152   unfolding bin_rl_def by (auto simp: bin_rest_BIT bin_last_BIT)
   153 
   154 primrec bin_nth where
   155   Z: "bin_nth w 0 = (bin_last w = (1::bit))"
   156   | Suc: "bin_nth w (Suc n) = bin_nth (bin_rest w) n"
   157 
   158 lemma bin_rl_simps [simp]:
   159   "bin_rl Int.Pls = (Int.Pls, (0::bit))"
   160   "bin_rl Int.Min = (Int.Min, (1::bit))"
   161   "bin_rl (Int.Bit0 r) = (r, (0::bit))"
   162   "bin_rl (Int.Bit1 r) = (r, (1::bit))"
   163   "bin_rl (r BIT b) = (r, b)"
   164   unfolding bin_rl_char by (simp_all add: BIT_simps)
   165 
   166 lemma bin_abs_lem:
   167   "bin = (w BIT b) ==> ~ bin = Int.Min --> ~ bin = Int.Pls -->
   168     nat (abs w) < nat (abs bin)"
   169   apply (clarsimp simp add: bin_rl_char)
   170   apply (unfold Pls_def Min_def Bit_def)
   171   apply (cases b)
   172    apply (clarsimp, arith)
   173   apply (clarsimp, arith)
   174   done
   175 
   176 lemma bin_induct:
   177   assumes PPls: "P Int.Pls"
   178     and PMin: "P Int.Min"
   179     and PBit: "!!bin bit. P bin ==> P (bin BIT bit)"
   180   shows "P bin"
   181   apply (rule_tac P=P and a=bin and f1="nat o abs" 
   182                   in wf_measure [THEN wf_induct])
   183   apply (simp add: measure_def inv_image_def)
   184   apply (case_tac x rule: bin_exhaust)
   185   apply (frule bin_abs_lem)
   186   apply (auto simp add : PPls PMin PBit)
   187   done
   188 
   189 lemma numeral_induct:
   190   assumes Pls: "P Int.Pls"
   191   assumes Min: "P Int.Min"
   192   assumes Bit0: "\<And>w. \<lbrakk>P w; w \<noteq> Int.Pls\<rbrakk> \<Longrightarrow> P (Int.Bit0 w)"
   193   assumes Bit1: "\<And>w. \<lbrakk>P w; w \<noteq> Int.Min\<rbrakk> \<Longrightarrow> P (Int.Bit1 w)"
   194   shows "P x"
   195   apply (induct x rule: bin_induct)
   196     apply (rule Pls)
   197    apply (rule Min)
   198   apply (case_tac bit)
   199    apply (case_tac "bin = Int.Pls")
   200     apply (simp add: BIT_simps)
   201    apply (simp add: Bit0 BIT_simps)
   202   apply (case_tac "bin = Int.Min")
   203    apply (simp add: BIT_simps)
   204   apply (simp add: Bit1 BIT_simps)
   205   done
   206 
   207 lemma bin_rest_simps [simp]: 
   208   "bin_rest Int.Pls = Int.Pls"
   209   "bin_rest Int.Min = Int.Min"
   210   "bin_rest (Int.Bit0 w) = w"
   211   "bin_rest (Int.Bit1 w) = w"
   212   "bin_rest (w BIT b) = w"
   213   using bin_rl_simps bin_rl_def by auto
   214 
   215 lemma bin_last_simps [simp]: 
   216   "bin_last Int.Pls = (0::bit)"
   217   "bin_last Int.Min = (1::bit)"
   218   "bin_last (Int.Bit0 w) = (0::bit)"
   219   "bin_last (Int.Bit1 w) = (1::bit)"
   220   "bin_last (w BIT b) = b"
   221   using bin_rl_simps bin_rl_def by auto
   222 
   223 lemma Bit_div2 [simp]: "(w BIT b) div 2 = w"
   224   unfolding bin_rest_def [symmetric] by auto
   225 
   226 lemma Bit0_div2 [simp]: "(Int.Bit0 w) div 2 = w"
   227   using Bit_div2 [where b="(0::bit)"] by (simp add: BIT_simps)
   228 
   229 lemma Bit1_div2 [simp]: "(Int.Bit1 w) div 2 = w"
   230   using Bit_div2 [where b="(1::bit)"] by (simp add: BIT_simps)
   231 
   232 lemma bin_nth_lem [rule_format]:
   233   "ALL y. bin_nth x = bin_nth y --> x = y"
   234   apply (induct x rule: bin_induct)
   235     apply safe
   236     apply (erule rev_mp)
   237     apply (induct_tac y rule: bin_induct)
   238       apply (safe del: subset_antisym)
   239       apply (drule_tac x=0 in fun_cong, force)
   240      apply (erule notE, rule ext, 
   241             drule_tac x="Suc x" in fun_cong, force)
   242     apply (drule_tac x=0 in fun_cong, force simp: BIT_simps)
   243    apply (erule rev_mp)
   244    apply (induct_tac y rule: bin_induct)
   245      apply (safe del: subset_antisym)
   246      apply (drule_tac x=0 in fun_cong, force)
   247     apply (erule notE, rule ext, 
   248            drule_tac x="Suc x" in fun_cong, force)
   249    apply (drule_tac x=0 in fun_cong, force simp: BIT_simps)
   250   apply (case_tac y rule: bin_exhaust)
   251   apply clarify
   252   apply (erule allE)
   253   apply (erule impE)
   254    prefer 2
   255    apply (erule conjI)
   256    apply (drule_tac x=0 in fun_cong, force)
   257   apply (rule ext)
   258   apply (drule_tac x="Suc ?x" in fun_cong, force)
   259   done
   260 
   261 lemma bin_nth_eq_iff: "(bin_nth x = bin_nth y) = (x = y)"
   262   by (auto elim: bin_nth_lem)
   263 
   264 lemmas bin_eqI = ext [THEN bin_nth_eq_iff [THEN iffD1]]
   265 
   266 lemma bin_eq_iff: "x = y \<longleftrightarrow> (\<forall>n. bin_nth x n = bin_nth y n)"
   267   by (auto intro!: bin_nth_lem del: equalityI)
   268 
   269 lemma bin_nth_zero [simp]: "\<not> bin_nth 0 n"
   270   by (induct n) auto
   271 
   272 lemma bin_nth_Pls [simp]: "~ bin_nth Int.Pls n"
   273   by (induct n) auto
   274 
   275 lemma bin_nth_minus1 [simp]: "bin_nth -1 n"
   276   by (induct n) auto
   277 
   278 lemma bin_nth_Min [simp]: "bin_nth Int.Min n"
   279   by (induct n) auto
   280 
   281 lemma bin_nth_0_BIT: "bin_nth (w BIT b) 0 = (b = (1::bit))"
   282   by auto
   283 
   284 lemma bin_nth_Suc_BIT: "bin_nth (w BIT b) (Suc n) = bin_nth w n"
   285   by auto
   286 
   287 lemma bin_nth_minus [simp]: "0 < n ==> bin_nth (w BIT b) n = bin_nth w (n - 1)"
   288   by (cases n) auto
   289 
   290 lemma bin_nth_minus_Bit0 [simp]:
   291   "0 < n ==> bin_nth (Int.Bit0 w) n = bin_nth w (n - 1)"
   292   using bin_nth_minus [where b="(0::bit)"] by (simp add: BIT_simps)
   293 
   294 lemma bin_nth_minus_Bit1 [simp]:
   295   "0 < n ==> bin_nth (Int.Bit1 w) n = bin_nth w (n - 1)"
   296   using bin_nth_minus [where b="(1::bit)"] by (simp add: BIT_simps)
   297 
   298 lemmas bin_nth_0 = bin_nth.simps(1)
   299 lemmas bin_nth_Suc = bin_nth.simps(2)
   300 
   301 lemmas bin_nth_simps = 
   302   bin_nth_0 bin_nth_Suc bin_nth_Pls bin_nth_Min bin_nth_minus
   303   bin_nth_minus_Bit0 bin_nth_minus_Bit1
   304 
   305 
   306 subsection {* Truncating binary integers *}
   307 
   308 definition bin_sign :: "int \<Rightarrow> int" where
   309   bin_sign_def: "bin_sign k = (if k \<ge> 0 then 0 else - 1)"
   310 
   311 lemma bin_sign_simps [simp]:
   312   "bin_sign 0 = 0"
   313   "bin_sign -1 = -1"
   314   "bin_sign (number_of (Int.Bit0 w)) = bin_sign (number_of w)"
   315   "bin_sign (number_of (Int.Bit1 w)) = bin_sign (number_of w)"
   316   "bin_sign Int.Pls = Int.Pls"
   317   "bin_sign Int.Min = Int.Min"
   318   "bin_sign (Int.Bit0 w) = bin_sign w"
   319   "bin_sign (Int.Bit1 w) = bin_sign w"
   320   "bin_sign (w BIT b) = bin_sign w"
   321   unfolding bin_sign_def numeral_simps Bit_def bitval_def number_of_is_id
   322   by (simp_all split: bit.split)
   323 
   324 lemma bin_sign_rest [simp]: 
   325   "bin_sign (bin_rest w) = bin_sign w"
   326   by (cases w rule: bin_exhaust) auto
   327 
   328 primrec bintrunc :: "nat \<Rightarrow> int \<Rightarrow> int" where
   329   Z : "bintrunc 0 bin = 0"
   330 | Suc : "bintrunc (Suc n) bin = bintrunc n (bin_rest bin) BIT (bin_last bin)"
   331 
   332 primrec sbintrunc :: "nat => int => int" where
   333   Z : "sbintrunc 0 bin = (case bin_last bin of (1::bit) \<Rightarrow> -1 | (0::bit) \<Rightarrow> 0)"
   334 | Suc : "sbintrunc (Suc n) bin = sbintrunc n (bin_rest bin) BIT (bin_last bin)"
   335 
   336 lemma sign_bintr: "bin_sign (bintrunc n w) = 0"
   337   by (induct n arbitrary: w) auto
   338 
   339 lemma bintrunc_mod2p: "bintrunc n w = (w mod 2 ^ n)"
   340   apply (induct n arbitrary: w)
   341   apply simp
   342   apply (simp add: bin_last_def bin_rest_def Bit_def zmod_zmult2_eq)
   343   done
   344 
   345 lemma sbintrunc_mod2p: "sbintrunc n w = (w + 2 ^ n) mod 2 ^ (Suc n) - 2 ^ n"
   346   apply (induct n arbitrary: w)
   347    apply clarsimp
   348    apply (subst mod_add_left_eq)
   349    apply (simp add: bin_last_def)
   350   apply simp
   351   apply (simp add: bin_last_def bin_rest_def Bit_def)
   352   apply (clarsimp simp: mod_mult_mult1 [symmetric] 
   353          zmod_zdiv_equality [THEN diff_eq_eq [THEN iffD2 [THEN sym]]])
   354   apply (rule trans [symmetric, OF _ emep1])
   355      apply auto
   356   apply (auto simp: even_def)
   357   done
   358 
   359 subsection "Simplifications for (s)bintrunc"
   360 
   361 lemma bintrunc_n_0 [simp]: "bintrunc n 0 = 0"
   362   by (induct n) auto
   363 
   364 lemma sbintrunc_n_0 [simp]: "sbintrunc n 0 = 0"
   365   by (induct n) auto
   366 
   367 lemma sbintrunc_n_minus1 [simp]: "sbintrunc n -1 = -1"
   368   by (induct n) auto
   369 
   370 lemma bintrunc_Suc_numeral:
   371   "bintrunc (Suc n) 1 = 1"
   372   "bintrunc (Suc n) -1 = bintrunc n -1 BIT 1"
   373   "bintrunc (Suc n) (number_of (Int.Bit0 w)) = bintrunc n (number_of w) BIT 0"
   374   "bintrunc (Suc n) (number_of (Int.Bit1 w)) = bintrunc n (number_of w) BIT 1"
   375   by simp_all
   376 
   377 lemma sbintrunc_0_numeral [simp]:
   378   "sbintrunc 0 1 = -1"
   379   "sbintrunc 0 (number_of (Int.Bit0 w)) = 0"
   380   "sbintrunc 0 (number_of (Int.Bit1 w)) = -1"
   381   by simp_all
   382 
   383 lemma sbintrunc_Suc_numeral:
   384   "sbintrunc (Suc n) 1 = 1"
   385   "sbintrunc (Suc n) (number_of (Int.Bit0 w)) = sbintrunc n (number_of w) BIT 0"
   386   "sbintrunc (Suc n) (number_of (Int.Bit1 w)) = sbintrunc n (number_of w) BIT 1"
   387   by simp_all
   388 
   389 lemma bit_bool:
   390   "(b = (b' = (1::bit))) = (b' = (if b then (1::bit) else (0::bit)))"
   391   by (cases b') auto
   392 
   393 lemmas bit_bool1 [simp] = refl [THEN bit_bool [THEN iffD1], symmetric]
   394 
   395 lemma bin_sign_lem: "(bin_sign (sbintrunc n bin) = -1) = bin_nth bin n"
   396   apply (induct n arbitrary: bin)
   397    apply (case_tac bin rule: bin_exhaust, case_tac b, auto)+
   398   done
   399 
   400 lemma nth_bintr: "bin_nth (bintrunc m w) n = (n < m & bin_nth w n)"
   401   apply (induct n arbitrary: w m)
   402    apply (case_tac m, auto)[1]
   403   apply (case_tac m, auto)[1]
   404   done
   405 
   406 lemma nth_sbintr:
   407   "bin_nth (sbintrunc m w) n = 
   408           (if n < m then bin_nth w n else bin_nth w m)"
   409   apply (induct n arbitrary: w m)
   410    apply (case_tac m, simp_all split: bit.splits)[1]
   411   apply (case_tac m, simp_all split: bit.splits)[1]
   412   done
   413 
   414 lemma bin_nth_Bit:
   415   "bin_nth (w BIT b) n = (n = 0 & b = (1::bit) | (EX m. n = Suc m & bin_nth w m))"
   416   by (cases n) auto
   417 
   418 lemma bin_nth_Bit0:
   419   "bin_nth (Int.Bit0 w) n = (EX m. n = Suc m & bin_nth w m)"
   420   using bin_nth_Bit [where b="(0::bit)"] by (simp add: BIT_simps)
   421 
   422 lemma bin_nth_Bit1:
   423   "bin_nth (Int.Bit1 w) n = (n = 0 | (EX m. n = Suc m & bin_nth w m))"
   424   using bin_nth_Bit [where b="(1::bit)"] by (simp add: BIT_simps)
   425 
   426 lemma bintrunc_bintrunc_l:
   427   "n <= m ==> (bintrunc m (bintrunc n w) = bintrunc n w)"
   428   by (rule bin_eqI) (auto simp add : nth_bintr)
   429 
   430 lemma sbintrunc_sbintrunc_l:
   431   "n <= m ==> (sbintrunc m (sbintrunc n w) = sbintrunc n w)"
   432   by (rule bin_eqI) (auto simp: nth_sbintr)
   433 
   434 lemma bintrunc_bintrunc_ge:
   435   "n <= m ==> (bintrunc n (bintrunc m w) = bintrunc n w)"
   436   by (rule bin_eqI) (auto simp: nth_bintr)
   437 
   438 lemma bintrunc_bintrunc_min [simp]:
   439   "bintrunc m (bintrunc n w) = bintrunc (min m n) w"
   440   apply (rule bin_eqI)
   441   apply (auto simp: nth_bintr)
   442   done
   443 
   444 lemma sbintrunc_sbintrunc_min [simp]:
   445   "sbintrunc m (sbintrunc n w) = sbintrunc (min m n) w"
   446   apply (rule bin_eqI)
   447   apply (auto simp: nth_sbintr min_max.inf_absorb1 min_max.inf_absorb2)
   448   done
   449 
   450 lemmas bintrunc_Pls = 
   451   bintrunc.Suc [where bin="Int.Pls", simplified bin_last_simps bin_rest_simps]
   452 
   453 lemmas bintrunc_Min [simp] = 
   454   bintrunc.Suc [where bin="Int.Min", simplified bin_last_simps bin_rest_simps]
   455 
   456 lemmas bintrunc_BIT  [simp] = 
   457   bintrunc.Suc [where bin="w BIT b", simplified bin_last_simps bin_rest_simps] for w b
   458 
   459 lemma bintrunc_Bit0 [simp]:
   460   "bintrunc (Suc n) (Int.Bit0 w) = Int.Bit0 (bintrunc n w)"
   461   using bintrunc_BIT [where b="(0::bit)"] by (simp add: BIT_simps)
   462 
   463 lemma bintrunc_Bit1 [simp]:
   464   "bintrunc (Suc n) (Int.Bit1 w) = Int.Bit1 (bintrunc n w)"
   465   using bintrunc_BIT [where b="(1::bit)"] by (simp add: BIT_simps)
   466 
   467 lemmas bintrunc_Sucs = bintrunc_Pls bintrunc_Min bintrunc_BIT
   468   bintrunc_Bit0 bintrunc_Bit1
   469   bintrunc_Suc_numeral
   470 
   471 lemmas sbintrunc_Suc_Pls = 
   472   sbintrunc.Suc [where bin="Int.Pls", simplified bin_last_simps bin_rest_simps]
   473 
   474 lemmas sbintrunc_Suc_Min = 
   475   sbintrunc.Suc [where bin="Int.Min", simplified bin_last_simps bin_rest_simps]
   476 
   477 lemmas sbintrunc_Suc_BIT [simp] = 
   478   sbintrunc.Suc [where bin="w BIT b", simplified bin_last_simps bin_rest_simps] for w b
   479 
   480 lemma sbintrunc_Suc_Bit0 [simp]:
   481   "sbintrunc (Suc n) (Int.Bit0 w) = Int.Bit0 (sbintrunc n w)"
   482   using sbintrunc_Suc_BIT [where b="(0::bit)"] by (simp add: BIT_simps)
   483 
   484 lemma sbintrunc_Suc_Bit1 [simp]:
   485   "sbintrunc (Suc n) (Int.Bit1 w) = Int.Bit1 (sbintrunc n w)"
   486   using sbintrunc_Suc_BIT [where b="(1::bit)"] by (simp add: BIT_simps)
   487 
   488 lemmas sbintrunc_Sucs = sbintrunc_Suc_Pls sbintrunc_Suc_Min sbintrunc_Suc_BIT
   489   sbintrunc_Suc_Bit0 sbintrunc_Suc_Bit1
   490   sbintrunc_Suc_numeral
   491 
   492 lemmas sbintrunc_Pls = 
   493   sbintrunc.Z [where bin="Int.Pls", 
   494                simplified bin_last_simps bin_rest_simps bit.simps]
   495 
   496 lemmas sbintrunc_Min = 
   497   sbintrunc.Z [where bin="Int.Min", 
   498                simplified bin_last_simps bin_rest_simps bit.simps]
   499 
   500 lemmas sbintrunc_0_BIT_B0 [simp] = 
   501   sbintrunc.Z [where bin="w BIT (0::bit)", 
   502                simplified bin_last_simps bin_rest_simps bit.simps] for w
   503 
   504 lemmas sbintrunc_0_BIT_B1 [simp] = 
   505   sbintrunc.Z [where bin="w BIT (1::bit)", 
   506                simplified bin_last_simps bin_rest_simps bit.simps] for w
   507 
   508 lemma sbintrunc_0_Bit0 [simp]: "sbintrunc 0 (Int.Bit0 w) = 0"
   509   using sbintrunc_0_BIT_B0 by simp
   510 
   511 lemma sbintrunc_0_Bit1 [simp]: "sbintrunc 0 (Int.Bit1 w) = -1"
   512   using sbintrunc_0_BIT_B1 by simp
   513 
   514 lemmas sbintrunc_0_simps =
   515   sbintrunc_Pls sbintrunc_Min sbintrunc_0_BIT_B0 sbintrunc_0_BIT_B1
   516   sbintrunc_0_Bit0 sbintrunc_0_Bit1
   517 
   518 lemmas bintrunc_simps = bintrunc.Z bintrunc_Sucs
   519 lemmas sbintrunc_simps = sbintrunc_0_simps sbintrunc_Sucs
   520 
   521 lemma bintrunc_minus:
   522   "0 < n ==> bintrunc (Suc (n - 1)) w = bintrunc n w"
   523   by auto
   524 
   525 lemma sbintrunc_minus:
   526   "0 < n ==> sbintrunc (Suc (n - 1)) w = sbintrunc n w"
   527   by auto
   528 
   529 lemmas bintrunc_minus_simps = 
   530   bintrunc_Sucs [THEN [2] bintrunc_minus [symmetric, THEN trans]]
   531 lemmas sbintrunc_minus_simps = 
   532   sbintrunc_Sucs [THEN [2] sbintrunc_minus [symmetric, THEN trans]]
   533 
   534 lemma bintrunc_n_Pls [simp]:
   535   "bintrunc n Int.Pls = Int.Pls"
   536   unfolding Pls_def by simp
   537 
   538 lemma sbintrunc_n_PM [simp]:
   539   "sbintrunc n Int.Pls = Int.Pls"
   540   "sbintrunc n Int.Min = Int.Min"
   541   unfolding Pls_def Min_def by simp_all
   542 
   543 lemmas thobini1 = arg_cong [where f = "%w. w BIT b"] for b
   544 
   545 lemmas bintrunc_BIT_I = trans [OF bintrunc_BIT thobini1]
   546 lemmas bintrunc_Min_I = trans [OF bintrunc_Min thobini1]
   547 
   548 lemmas bmsts = bintrunc_minus_simps(1-3) [THEN thobini1 [THEN [2] trans]]
   549 lemmas bintrunc_Pls_minus_I = bmsts(1)
   550 lemmas bintrunc_Min_minus_I = bmsts(2)
   551 lemmas bintrunc_BIT_minus_I = bmsts(3)
   552 
   553 lemma bintrunc_Suc_lem:
   554   "bintrunc (Suc n) x = y ==> m = Suc n ==> bintrunc m x = y"
   555   by auto
   556 
   557 lemmas bintrunc_Suc_Ialts = 
   558   bintrunc_Min_I [THEN bintrunc_Suc_lem]
   559   bintrunc_BIT_I [THEN bintrunc_Suc_lem]
   560 
   561 lemmas sbintrunc_BIT_I = trans [OF sbintrunc_Suc_BIT thobini1]
   562 
   563 lemmas sbintrunc_Suc_Is = 
   564   sbintrunc_Sucs(1-3) [THEN thobini1 [THEN [2] trans]]
   565 
   566 lemmas sbintrunc_Suc_minus_Is = 
   567   sbintrunc_minus_simps(1-3) [THEN thobini1 [THEN [2] trans]]
   568 
   569 lemma sbintrunc_Suc_lem:
   570   "sbintrunc (Suc n) x = y ==> m = Suc n ==> sbintrunc m x = y"
   571   by auto
   572 
   573 lemmas sbintrunc_Suc_Ialts = 
   574   sbintrunc_Suc_Is [THEN sbintrunc_Suc_lem]
   575 
   576 lemma sbintrunc_bintrunc_lt:
   577   "m > n ==> sbintrunc n (bintrunc m w) = sbintrunc n w"
   578   by (rule bin_eqI) (auto simp: nth_sbintr nth_bintr)
   579 
   580 lemma bintrunc_sbintrunc_le:
   581   "m <= Suc n ==> bintrunc m (sbintrunc n w) = bintrunc m w"
   582   apply (rule bin_eqI)
   583   apply (auto simp: nth_sbintr nth_bintr)
   584    apply (subgoal_tac "x=n", safe, arith+)[1]
   585   apply (subgoal_tac "x=n", safe, arith+)[1]
   586   done
   587 
   588 lemmas bintrunc_sbintrunc [simp] = order_refl [THEN bintrunc_sbintrunc_le]
   589 lemmas sbintrunc_bintrunc [simp] = lessI [THEN sbintrunc_bintrunc_lt]
   590 lemmas bintrunc_bintrunc [simp] = order_refl [THEN bintrunc_bintrunc_l]
   591 lemmas sbintrunc_sbintrunc [simp] = order_refl [THEN sbintrunc_sbintrunc_l] 
   592 
   593 lemma bintrunc_sbintrunc' [simp]:
   594   "0 < n \<Longrightarrow> bintrunc n (sbintrunc (n - 1) w) = bintrunc n w"
   595   by (cases n) (auto simp del: bintrunc.Suc)
   596 
   597 lemma sbintrunc_bintrunc' [simp]:
   598   "0 < n \<Longrightarrow> sbintrunc (n - 1) (bintrunc n w) = sbintrunc (n - 1) w"
   599   by (cases n) (auto simp del: bintrunc.Suc)
   600 
   601 lemma bin_sbin_eq_iff: 
   602   "bintrunc (Suc n) x = bintrunc (Suc n) y <-> 
   603    sbintrunc n x = sbintrunc n y"
   604   apply (rule iffI)
   605    apply (rule box_equals [OF _ sbintrunc_bintrunc sbintrunc_bintrunc])
   606    apply simp
   607   apply (rule box_equals [OF _ bintrunc_sbintrunc bintrunc_sbintrunc])
   608   apply simp
   609   done
   610 
   611 lemma bin_sbin_eq_iff':
   612   "0 < n \<Longrightarrow> bintrunc n x = bintrunc n y <-> 
   613             sbintrunc (n - 1) x = sbintrunc (n - 1) y"
   614   by (cases n) (simp_all add: bin_sbin_eq_iff del: bintrunc.Suc)
   615 
   616 lemmas bintrunc_sbintruncS0 [simp] = bintrunc_sbintrunc' [unfolded One_nat_def]
   617 lemmas sbintrunc_bintruncS0 [simp] = sbintrunc_bintrunc' [unfolded One_nat_def]
   618 
   619 lemmas bintrunc_bintrunc_l' = le_add1 [THEN bintrunc_bintrunc_l]
   620 lemmas sbintrunc_sbintrunc_l' = le_add1 [THEN sbintrunc_sbintrunc_l]
   621 
   622 (* although bintrunc_minus_simps, if added to default simpset,
   623   tends to get applied where it's not wanted in developing the theories,
   624   we get a version for when the word length is given literally *)
   625 
   626 lemmas nat_non0_gr = 
   627   trans [OF iszero_def [THEN Not_eq_iff [THEN iffD2]] refl]
   628 
   629 lemmas bintrunc_pred_simps [simp] = 
   630   bintrunc_minus_simps [of "number_of bin", simplified nobm1] for bin
   631 
   632 lemmas sbintrunc_pred_simps [simp] = 
   633   sbintrunc_minus_simps [of "number_of bin", simplified nobm1] for bin
   634 
   635 lemma no_bintr_alt:
   636   "number_of (bintrunc n w) = w mod 2 ^ n"
   637   by (simp add: number_of_eq bintrunc_mod2p)
   638 
   639 lemma no_bintr_alt1: "bintrunc n = (%w. w mod 2 ^ n :: int)"
   640   by (rule ext) (rule bintrunc_mod2p)
   641 
   642 lemma range_bintrunc: "range (bintrunc n) = {i. 0 <= i & i < 2 ^ n}"
   643   apply (unfold no_bintr_alt1)
   644   apply (auto simp add: image_iff)
   645   apply (rule exI)
   646   apply (auto intro: int_mod_lem [THEN iffD1, symmetric])
   647   done
   648 
   649 lemma no_bintr: 
   650   "number_of (bintrunc n w) = (number_of w mod 2 ^ n :: int)"
   651   by (simp add : bintrunc_mod2p number_of_eq)
   652 
   653 lemma no_sbintr_alt2: 
   654   "sbintrunc n = (%w. (w + 2 ^ n) mod 2 ^ Suc n - 2 ^ n :: int)"
   655   by (rule ext) (simp add : sbintrunc_mod2p)
   656 
   657 lemma no_sbintr: 
   658   "number_of (sbintrunc n w) = 
   659    ((number_of w + 2 ^ n) mod 2 ^ Suc n - 2 ^ n :: int)"
   660   by (simp add : no_sbintr_alt2 number_of_eq)
   661 
   662 lemma range_sbintrunc: 
   663   "range (sbintrunc n) = {i. - (2 ^ n) <= i & i < 2 ^ n}"
   664   apply (unfold no_sbintr_alt2)
   665   apply (auto simp add: image_iff eq_diff_eq)
   666   apply (rule exI)
   667   apply (auto intro: int_mod_lem [THEN iffD1, symmetric])
   668   done
   669 
   670 lemma sb_inc_lem:
   671   "(a::int) + 2^k < 0 \<Longrightarrow> a + 2^k + 2^(Suc k) <= (a + 2^k) mod 2^(Suc k)"
   672   apply (erule int_mod_ge' [where n = "2 ^ (Suc k)" and b = "a + 2 ^ k", simplified zless2p])
   673   apply (rule TrueI)
   674   done
   675 
   676 lemma sb_inc_lem':
   677   "(a::int) < - (2^k) \<Longrightarrow> a + 2^k + 2^(Suc k) <= (a + 2^k) mod 2^(Suc k)"
   678   by (rule sb_inc_lem) simp
   679 
   680 lemma sbintrunc_inc:
   681   "x < - (2^n) ==> x + 2^(Suc n) <= sbintrunc n x"
   682   unfolding no_sbintr_alt2 by (drule sb_inc_lem') simp
   683 
   684 lemma sb_dec_lem:
   685   "(0::int) <= - (2^k) + a ==> (a + 2^k) mod (2 * 2 ^ k) <= - (2 ^ k) + a"
   686   by (rule int_mod_le' [where n = "2 ^ (Suc k)" and b = "a + 2 ^ k",
   687     simplified zless2p, OF _ TrueI, simplified])
   688 
   689 lemma sb_dec_lem':
   690   "(2::int) ^ k <= a ==> (a + 2 ^ k) mod (2 * 2 ^ k) <= - (2 ^ k) + a"
   691   by (rule iffD1 [OF diff_le_eq', THEN sb_dec_lem, simplified])
   692 
   693 lemma sbintrunc_dec:
   694   "x >= (2 ^ n) ==> x - 2 ^ (Suc n) >= sbintrunc n x"
   695   unfolding no_sbintr_alt2 by (drule sb_dec_lem') simp
   696 
   697 lemmas zmod_uminus' = zmod_uminus [where b=c] for c
   698 lemmas zpower_zmod' = zpower_zmod [where m=c and y=k] for c k
   699 
   700 lemmas brdmod1s' [symmetric] = 
   701   mod_add_left_eq mod_add_right_eq 
   702   zmod_zsub_left_eq zmod_zsub_right_eq 
   703   zmod_zmult1_eq zmod_zmult1_eq_rev 
   704 
   705 lemmas brdmods' [symmetric] = 
   706   zpower_zmod' [symmetric]
   707   trans [OF mod_add_left_eq mod_add_right_eq] 
   708   trans [OF zmod_zsub_left_eq zmod_zsub_right_eq] 
   709   trans [OF zmod_zmult1_eq zmod_zmult1_eq_rev] 
   710   zmod_uminus' [symmetric]
   711   mod_add_left_eq [where b = "1::int"]
   712   zmod_zsub_left_eq [where b = "1"]
   713 
   714 lemmas bintr_arith1s =
   715   brdmod1s' [where c="2^n::int", folded bintrunc_mod2p] for n
   716 lemmas bintr_ariths =
   717   brdmods' [where c="2^n::int", folded bintrunc_mod2p] for n
   718 
   719 lemmas m2pths = pos_mod_sign pos_mod_bound [OF zless2p]
   720 
   721 lemma bintr_ge0: "(0 :: int) <= number_of (bintrunc n w)"
   722   by (simp add : no_bintr m2pths)
   723 
   724 lemma bintr_lt2p: "number_of (bintrunc n w) < (2 ^ n :: int)"
   725   by (simp add : no_bintr m2pths)
   726 
   727 lemma bintr_Min: 
   728   "number_of (bintrunc n Int.Min) = (2 ^ n :: int) - 1"
   729   by (simp add : no_bintr m1mod2k)
   730 
   731 lemma sbintr_ge: "(- (2 ^ n) :: int) <= number_of (sbintrunc n w)"
   732   by (simp add : no_sbintr m2pths)
   733 
   734 lemma sbintr_lt: "number_of (sbintrunc n w) < (2 ^ n :: int)"
   735   by (simp add : no_sbintr m2pths)
   736 
   737 lemma bintrunc_Suc:
   738   "bintrunc (Suc n) bin = bintrunc n (bin_rest bin) BIT bin_last bin"
   739   by (case_tac bin rule: bin_exhaust) auto
   740 
   741 lemma sign_Pls_ge_0: 
   742   "(bin_sign bin = Int.Pls) = (number_of bin >= (0 :: int))"
   743   by (induct bin rule: numeral_induct) auto
   744 
   745 lemma sign_Min_lt_0: 
   746   "(bin_sign bin = Int.Min) = (number_of bin < (0 :: int))"
   747   by (induct bin rule: numeral_induct) auto
   748 
   749 lemmas sign_Min_neg = trans [OF sign_Min_lt_0 neg_def [symmetric]] 
   750 
   751 lemma bin_rest_trunc:
   752   "(bin_rest (bintrunc n bin)) = bintrunc (n - 1) (bin_rest bin)"
   753   by (induct n arbitrary: bin) auto
   754 
   755 lemma bin_rest_power_trunc [rule_format] :
   756   "(bin_rest ^^ k) (bintrunc n bin) = 
   757     bintrunc (n - k) ((bin_rest ^^ k) bin)"
   758   by (induct k) (auto simp: bin_rest_trunc)
   759 
   760 lemma bin_rest_trunc_i:
   761   "bintrunc n (bin_rest bin) = bin_rest (bintrunc (Suc n) bin)"
   762   by auto
   763 
   764 lemma bin_rest_strunc:
   765   "bin_rest (sbintrunc (Suc n) bin) = sbintrunc n (bin_rest bin)"
   766   by (induct n arbitrary: bin) auto
   767 
   768 lemma bintrunc_rest [simp]: 
   769   "bintrunc n (bin_rest (bintrunc n bin)) = bin_rest (bintrunc n bin)"
   770   apply (induct n arbitrary: bin, simp)
   771   apply (case_tac bin rule: bin_exhaust)
   772   apply (auto simp: bintrunc_bintrunc_l)
   773   done
   774 
   775 lemma sbintrunc_rest [simp]:
   776   "sbintrunc n (bin_rest (sbintrunc n bin)) = bin_rest (sbintrunc n bin)"
   777   apply (induct n arbitrary: bin, simp)
   778   apply (case_tac bin rule: bin_exhaust)
   779   apply (auto simp: bintrunc_bintrunc_l split: bit.splits)
   780   done
   781 
   782 lemma bintrunc_rest':
   783   "bintrunc n o bin_rest o bintrunc n = bin_rest o bintrunc n"
   784   by (rule ext) auto
   785 
   786 lemma sbintrunc_rest' :
   787   "sbintrunc n o bin_rest o sbintrunc n = bin_rest o sbintrunc n"
   788   by (rule ext) auto
   789 
   790 lemma rco_lem:
   791   "f o g o f = g o f ==> f o (g o f) ^^ n = g ^^ n o f"
   792   apply (rule ext)
   793   apply (induct_tac n)
   794    apply (simp_all (no_asm))
   795   apply (drule fun_cong)
   796   apply (unfold o_def)
   797   apply (erule trans)
   798   apply simp
   799   done
   800 
   801 lemma rco_alt: "(f o g) ^^ n o f = f o (g o f) ^^ n"
   802   apply (rule ext)
   803   apply (induct n)
   804    apply (simp_all add: o_def)
   805   done
   806 
   807 lemmas rco_bintr = bintrunc_rest' 
   808   [THEN rco_lem [THEN fun_cong], unfolded o_def]
   809 lemmas rco_sbintr = sbintrunc_rest' 
   810   [THEN rco_lem [THEN fun_cong], unfolded o_def]
   811 
   812 subsection {* Splitting and concatenation *}
   813 
   814 primrec bin_split :: "nat \<Rightarrow> int \<Rightarrow> int \<times> int" where
   815   Z: "bin_split 0 w = (w, 0)"
   816   | Suc: "bin_split (Suc n) w = (let (w1, w2) = bin_split n (bin_rest w)
   817         in (w1, w2 BIT bin_last w))"
   818 
   819 lemma [code]:
   820   "bin_split (Suc n) w = (let (w1, w2) = bin_split n (bin_rest w) in (w1, w2 BIT bin_last w))"
   821   "bin_split 0 w = (w, 0)"
   822   by (simp_all add: Pls_def)
   823 
   824 primrec bin_cat :: "int \<Rightarrow> nat \<Rightarrow> int \<Rightarrow> int" where
   825   Z: "bin_cat w 0 v = w"
   826   | Suc: "bin_cat w (Suc n) v = bin_cat w n (bin_rest v) BIT bin_last v"
   827 
   828 subsection {* Miscellaneous lemmas *}
   829 
   830 lemma funpow_minus_simp:
   831   "0 < n \<Longrightarrow> f ^^ n = f \<circ> f ^^ (n - 1)"
   832   by (cases n) simp_all
   833 
   834 lemmas funpow_pred_simp [simp] =
   835   funpow_minus_simp [of "number_of bin", simplified nobm1] for bin
   836 
   837 lemmas replicate_minus_simp = 
   838   trans [OF gen_minus [where f = "%n. replicate n x"] replicate.replicate_Suc] for x
   839 
   840 lemmas replicate_pred_simp [simp] =
   841   replicate_minus_simp [of "number_of bin", simplified nobm1] for bin
   842 
   843 lemmas power_Suc_no [simp] = power_Suc [of "number_of a"] for a
   844 
   845 lemmas power_minus_simp = 
   846   trans [OF gen_minus [where f = "power f"] power_Suc] for f
   847 
   848 lemmas power_pred_simp = 
   849   power_minus_simp [of "number_of bin", simplified nobm1] for bin
   850 lemmas power_pred_simp_no [simp] = power_pred_simp [where f= "number_of f"] for f
   851 
   852 lemma list_exhaust_size_gt0:
   853   assumes y: "\<And>a list. y = a # list \<Longrightarrow> P"
   854   shows "0 < length y \<Longrightarrow> P"
   855   apply (cases y, simp)
   856   apply (rule y)
   857   apply fastforce
   858   done
   859 
   860 lemma list_exhaust_size_eq0:
   861   assumes y: "y = [] \<Longrightarrow> P"
   862   shows "length y = 0 \<Longrightarrow> P"
   863   apply (cases y)
   864    apply (rule y, simp)
   865   apply simp
   866   done
   867 
   868 lemma size_Cons_lem_eq:
   869   "y = xa # list ==> size y = Suc k ==> size list = k"
   870   by auto
   871 
   872 lemma size_Cons_lem_eq_bin:
   873   "y = xa # list ==> size y = number_of (Int.succ k) ==> 
   874     size list = number_of k"
   875   by (auto simp: pred_def succ_def split add : split_if_asm)
   876 
   877 lemmas ls_splits = prod.split prod.split_asm split_if_asm
   878 
   879 lemma not_B1_is_B0: "y \<noteq> (1::bit) \<Longrightarrow> y = (0::bit)"
   880   by (cases y) auto
   881 
   882 lemma B1_ass_B0: 
   883   assumes y: "y = (0::bit) \<Longrightarrow> y = (1::bit)"
   884   shows "y = (1::bit)"
   885   apply (rule classical)
   886   apply (drule not_B1_is_B0)
   887   apply (erule y)
   888   done
   889 
   890 -- "simplifications for specific word lengths"
   891 lemmas n2s_ths [THEN eq_reflection] = add_2_eq_Suc add_2_eq_Suc'
   892 
   893 lemmas s2n_ths = n2s_ths [symmetric]
   894 
   895 end