src/HOL/Library/Code_Binary_Nat.thy
author wenzelm
Wed Jun 17 11:03:05 2015 +0200 (2015-06-17)
changeset 60500 903bb1495239
parent 58881 b9556a055632
child 60868 dd18c33c001e
permissions -rw-r--r--
isabelle update_cartouches;
haftmann@50023
     1
(*  Title:      HOL/Library/Code_Binary_Nat.thy
haftmann@51113
     2
    Author:     Florian Haftmann, TU Muenchen
huffman@47108
     3
*)
huffman@47108
     4
wenzelm@60500
     5
section \<open>Implementation of natural numbers as binary numerals\<close>
huffman@47108
     6
haftmann@50023
     7
theory Code_Binary_Nat
haftmann@51113
     8
imports Code_Abstract_Nat
huffman@47108
     9
begin
huffman@47108
    10
wenzelm@60500
    11
text \<open>
huffman@47108
    12
  When generating code for functions on natural numbers, the
huffman@47108
    13
  canonical representation using @{term "0::nat"} and
huffman@47108
    14
  @{term Suc} is unsuitable for computations involving large
huffman@47108
    15
  numbers.  This theory refines the representation of
huffman@47108
    16
  natural numbers for code generation to use binary
huffman@47108
    17
  numerals, which do not grow linear in size but logarithmic.
wenzelm@60500
    18
\<close>
huffman@47108
    19
wenzelm@60500
    20
subsection \<open>Representation\<close>
huffman@47108
    21
haftmann@50023
    22
code_datatype "0::nat" nat_of_num
haftmann@50023
    23
huffman@47108
    24
lemma [code]:
huffman@47108
    25
  "num_of_nat 0 = Num.One"
huffman@47108
    26
  "num_of_nat (nat_of_num k) = k"
huffman@47108
    27
  by (simp_all add: nat_of_num_inverse)
huffman@47108
    28
huffman@47108
    29
lemma [code]:
huffman@47108
    30
  "(1\<Colon>nat) = Numeral1"
huffman@47108
    31
  by simp
huffman@47108
    32
huffman@47108
    33
lemma [code_abbrev]: "Numeral1 = (1\<Colon>nat)"
huffman@47108
    34
  by simp
huffman@47108
    35
huffman@47108
    36
lemma [code]:
huffman@47108
    37
  "Suc n = n + 1"
huffman@47108
    38
  by simp
huffman@47108
    39
huffman@47108
    40
wenzelm@60500
    41
subsection \<open>Basic arithmetic\<close>
huffman@47108
    42
huffman@47108
    43
lemma [code, code del]:
huffman@47108
    44
  "(plus :: nat \<Rightarrow> _) = plus" ..
huffman@47108
    45
huffman@47108
    46
lemma plus_nat_code [code]:
huffman@47108
    47
  "nat_of_num k + nat_of_num l = nat_of_num (k + l)"
huffman@47108
    48
  "m + 0 = (m::nat)"
huffman@47108
    49
  "0 + n = (n::nat)"
huffman@47108
    50
  by (simp_all add: nat_of_num_numeral)
huffman@47108
    51
wenzelm@60500
    52
text \<open>Bounded subtraction needs some auxiliary\<close>
huffman@47108
    53
huffman@47108
    54
definition dup :: "nat \<Rightarrow> nat" where
huffman@47108
    55
  "dup n = n + n"
huffman@47108
    56
huffman@47108
    57
lemma dup_code [code]:
huffman@47108
    58
  "dup 0 = 0"
huffman@47108
    59
  "dup (nat_of_num k) = nat_of_num (Num.Bit0 k)"
haftmann@50023
    60
  by (simp_all add: dup_def numeral_Bit0)
huffman@47108
    61
huffman@47108
    62
definition sub :: "num \<Rightarrow> num \<Rightarrow> nat option" where
huffman@47108
    63
  "sub k l = (if k \<ge> l then Some (numeral k - numeral l) else None)"
huffman@47108
    64
huffman@47108
    65
lemma sub_code [code]:
huffman@47108
    66
  "sub Num.One Num.One = Some 0"
huffman@47108
    67
  "sub (Num.Bit0 m) Num.One = Some (nat_of_num (Num.BitM m))"
huffman@47108
    68
  "sub (Num.Bit1 m) Num.One = Some (nat_of_num (Num.Bit0 m))"
huffman@47108
    69
  "sub Num.One (Num.Bit0 n) = None"
huffman@47108
    70
  "sub Num.One (Num.Bit1 n) = None"
blanchet@55466
    71
  "sub (Num.Bit0 m) (Num.Bit0 n) = map_option dup (sub m n)"
blanchet@55466
    72
  "sub (Num.Bit1 m) (Num.Bit1 n) = map_option dup (sub m n)"
blanchet@55466
    73
  "sub (Num.Bit1 m) (Num.Bit0 n) = map_option (\<lambda>q. dup q + 1) (sub m n)"
huffman@47108
    74
  "sub (Num.Bit0 m) (Num.Bit1 n) = (case sub m n of None \<Rightarrow> None
huffman@47108
    75
     | Some q \<Rightarrow> if q = 0 then None else Some (dup q - 1))"
huffman@47108
    76
  apply (auto simp add: nat_of_num_numeral
huffman@47108
    77
    Num.dbl_def Num.dbl_inc_def Num.dbl_dec_def
huffman@47108
    78
    Let_def le_imp_diff_is_add BitM_plus_one sub_def dup_def)
huffman@47108
    79
  apply (simp_all add: sub_non_positive)
huffman@47108
    80
  apply (simp_all add: sub_non_negative [symmetric, where ?'a = int])
huffman@47108
    81
  done
huffman@47108
    82
huffman@47108
    83
lemma [code, code del]:
huffman@47108
    84
  "(minus :: nat \<Rightarrow> _) = minus" ..
huffman@47108
    85
huffman@47108
    86
lemma minus_nat_code [code]:
huffman@47108
    87
  "nat_of_num k - nat_of_num l = (case sub k l of None \<Rightarrow> 0 | Some j \<Rightarrow> j)"
huffman@47108
    88
  "m - 0 = (m::nat)"
huffman@47108
    89
  "0 - n = (0::nat)"
huffman@47108
    90
  by (simp_all add: nat_of_num_numeral sub_non_positive sub_def)
huffman@47108
    91
huffman@47108
    92
lemma [code, code del]:
huffman@47108
    93
  "(times :: nat \<Rightarrow> _) = times" ..
huffman@47108
    94
huffman@47108
    95
lemma times_nat_code [code]:
huffman@47108
    96
  "nat_of_num k * nat_of_num l = nat_of_num (k * l)"
huffman@47108
    97
  "m * 0 = (0::nat)"
huffman@47108
    98
  "0 * n = (0::nat)"
huffman@47108
    99
  by (simp_all add: nat_of_num_numeral)
huffman@47108
   100
huffman@47108
   101
lemma [code, code del]:
huffman@47108
   102
  "(HOL.equal :: nat \<Rightarrow> _) = HOL.equal" ..
huffman@47108
   103
huffman@47108
   104
lemma equal_nat_code [code]:
huffman@47108
   105
  "HOL.equal 0 (0::nat) \<longleftrightarrow> True"
huffman@47108
   106
  "HOL.equal 0 (nat_of_num l) \<longleftrightarrow> False"
huffman@47108
   107
  "HOL.equal (nat_of_num k) 0 \<longleftrightarrow> False"
huffman@47108
   108
  "HOL.equal (nat_of_num k) (nat_of_num l) \<longleftrightarrow> HOL.equal k l"
huffman@47108
   109
  by (simp_all add: nat_of_num_numeral equal)
huffman@47108
   110
huffman@47108
   111
lemma equal_nat_refl [code nbe]:
huffman@47108
   112
  "HOL.equal (n::nat) n \<longleftrightarrow> True"
huffman@47108
   113
  by (rule equal_refl)
huffman@47108
   114
huffman@47108
   115
lemma [code, code del]:
huffman@47108
   116
  "(less_eq :: nat \<Rightarrow> _) = less_eq" ..
huffman@47108
   117
huffman@47108
   118
lemma less_eq_nat_code [code]:
huffman@47108
   119
  "0 \<le> (n::nat) \<longleftrightarrow> True"
huffman@47108
   120
  "nat_of_num k \<le> 0 \<longleftrightarrow> False"
huffman@47108
   121
  "nat_of_num k \<le> nat_of_num l \<longleftrightarrow> k \<le> l"
huffman@47108
   122
  by (simp_all add: nat_of_num_numeral)
huffman@47108
   123
huffman@47108
   124
lemma [code, code del]:
huffman@47108
   125
  "(less :: nat \<Rightarrow> _) = less" ..
huffman@47108
   126
huffman@47108
   127
lemma less_nat_code [code]:
huffman@47108
   128
  "(m::nat) < 0 \<longleftrightarrow> False"
huffman@47108
   129
  "0 < nat_of_num l \<longleftrightarrow> True"
huffman@47108
   130
  "nat_of_num k < nat_of_num l \<longleftrightarrow> k < l"
huffman@47108
   131
  by (simp_all add: nat_of_num_numeral)
huffman@47108
   132
haftmann@53069
   133
lemma [code, code del]:
haftmann@53069
   134
  "divmod_nat = divmod_nat" ..
haftmann@53069
   135
  
haftmann@53069
   136
lemma divmod_nat_code [code]:
haftmann@53069
   137
  "divmod_nat (nat_of_num k) (nat_of_num l) = divmod k l"
haftmann@53069
   138
  "divmod_nat m 0 = (0, m)"
haftmann@53069
   139
  "divmod_nat 0 n = (0, 0)"
haftmann@53069
   140
  by (simp_all add: prod_eq_iff nat_of_num_numeral del: div_nat_numeral mod_nat_numeral)
haftmann@53069
   141
huffman@47108
   142
wenzelm@60500
   143
subsection \<open>Conversions\<close>
huffman@47108
   144
huffman@47108
   145
lemma [code, code del]:
huffman@47108
   146
  "of_nat = of_nat" ..
huffman@47108
   147
huffman@47108
   148
lemma of_nat_code [code]:
huffman@47108
   149
  "of_nat 0 = 0"
huffman@47108
   150
  "of_nat (nat_of_num k) = numeral k"
huffman@47108
   151
  by (simp_all add: nat_of_num_numeral)
huffman@47108
   152
huffman@47108
   153
haftmann@52435
   154
code_identifier
haftmann@52435
   155
  code_module Code_Binary_Nat \<rightharpoonup>
haftmann@52435
   156
    (SML) Arith and (OCaml) Arith and (Haskell) Arith
huffman@47108
   157
huffman@47108
   158
hide_const (open) dup sub
huffman@47108
   159
huffman@47108
   160
end
haftmann@50023
   161