src/HOL/Library/Code_Binary_Nat.thy
author wenzelm
Mon Dec 28 01:28:28 2015 +0100 (2015-12-28)
changeset 61945 1135b8de26c3
parent 61433 a4c0de1df3d8
child 66148 5e60c2d0a1f1
permissions -rw-r--r--
more symbols;
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]:
wenzelm@61076
    30
  "(1::nat) = Numeral1"
huffman@47108
    31
  by simp
huffman@47108
    32
wenzelm@61076
    33
lemma [code_abbrev]: "Numeral1 = (1::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
wenzelm@61115
    43
context
wenzelm@61115
    44
begin
wenzelm@61115
    45
huffman@47108
    46
lemma [code, code del]:
huffman@47108
    47
  "(plus :: nat \<Rightarrow> _) = plus" ..
huffman@47108
    48
huffman@47108
    49
lemma plus_nat_code [code]:
huffman@47108
    50
  "nat_of_num k + nat_of_num l = nat_of_num (k + l)"
huffman@47108
    51
  "m + 0 = (m::nat)"
huffman@47108
    52
  "0 + n = (n::nat)"
huffman@47108
    53
  by (simp_all add: nat_of_num_numeral)
huffman@47108
    54
wenzelm@60500
    55
text \<open>Bounded subtraction needs some auxiliary\<close>
huffman@47108
    56
wenzelm@61115
    57
qualified definition dup :: "nat \<Rightarrow> nat" where
huffman@47108
    58
  "dup n = n + n"
huffman@47108
    59
huffman@47108
    60
lemma dup_code [code]:
huffman@47108
    61
  "dup 0 = 0"
huffman@47108
    62
  "dup (nat_of_num k) = nat_of_num (Num.Bit0 k)"
haftmann@50023
    63
  by (simp_all add: dup_def numeral_Bit0)
huffman@47108
    64
wenzelm@61115
    65
qualified definition sub :: "num \<Rightarrow> num \<Rightarrow> nat option" where
huffman@47108
    66
  "sub k l = (if k \<ge> l then Some (numeral k - numeral l) else None)"
huffman@47108
    67
huffman@47108
    68
lemma sub_code [code]:
huffman@47108
    69
  "sub Num.One Num.One = Some 0"
huffman@47108
    70
  "sub (Num.Bit0 m) Num.One = Some (nat_of_num (Num.BitM m))"
huffman@47108
    71
  "sub (Num.Bit1 m) Num.One = Some (nat_of_num (Num.Bit0 m))"
huffman@47108
    72
  "sub Num.One (Num.Bit0 n) = None"
huffman@47108
    73
  "sub Num.One (Num.Bit1 n) = None"
blanchet@55466
    74
  "sub (Num.Bit0 m) (Num.Bit0 n) = map_option dup (sub m n)"
blanchet@55466
    75
  "sub (Num.Bit1 m) (Num.Bit1 n) = map_option dup (sub m n)"
blanchet@55466
    76
  "sub (Num.Bit1 m) (Num.Bit0 n) = map_option (\<lambda>q. dup q + 1) (sub m n)"
huffman@47108
    77
  "sub (Num.Bit0 m) (Num.Bit1 n) = (case sub m n of None \<Rightarrow> None
huffman@47108
    78
     | Some q \<Rightarrow> if q = 0 then None else Some (dup q - 1))"
huffman@47108
    79
  apply (auto simp add: nat_of_num_numeral
huffman@47108
    80
    Num.dbl_def Num.dbl_inc_def Num.dbl_dec_def
huffman@47108
    81
    Let_def le_imp_diff_is_add BitM_plus_one sub_def dup_def)
huffman@47108
    82
  apply (simp_all add: sub_non_positive)
huffman@47108
    83
  apply (simp_all add: sub_non_negative [symmetric, where ?'a = int])
huffman@47108
    84
  done
huffman@47108
    85
huffman@47108
    86
lemma [code, code del]:
huffman@47108
    87
  "(minus :: nat \<Rightarrow> _) = minus" ..
huffman@47108
    88
huffman@47108
    89
lemma minus_nat_code [code]:
huffman@47108
    90
  "nat_of_num k - nat_of_num l = (case sub k l of None \<Rightarrow> 0 | Some j \<Rightarrow> j)"
huffman@47108
    91
  "m - 0 = (m::nat)"
huffman@47108
    92
  "0 - n = (0::nat)"
huffman@47108
    93
  by (simp_all add: nat_of_num_numeral sub_non_positive sub_def)
huffman@47108
    94
huffman@47108
    95
lemma [code, code del]:
huffman@47108
    96
  "(times :: nat \<Rightarrow> _) = times" ..
huffman@47108
    97
huffman@47108
    98
lemma times_nat_code [code]:
huffman@47108
    99
  "nat_of_num k * nat_of_num l = nat_of_num (k * l)"
huffman@47108
   100
  "m * 0 = (0::nat)"
huffman@47108
   101
  "0 * n = (0::nat)"
huffman@47108
   102
  by (simp_all add: nat_of_num_numeral)
huffman@47108
   103
huffman@47108
   104
lemma [code, code del]:
huffman@47108
   105
  "(HOL.equal :: nat \<Rightarrow> _) = HOL.equal" ..
huffman@47108
   106
huffman@47108
   107
lemma equal_nat_code [code]:
huffman@47108
   108
  "HOL.equal 0 (0::nat) \<longleftrightarrow> True"
huffman@47108
   109
  "HOL.equal 0 (nat_of_num l) \<longleftrightarrow> False"
huffman@47108
   110
  "HOL.equal (nat_of_num k) 0 \<longleftrightarrow> False"
huffman@47108
   111
  "HOL.equal (nat_of_num k) (nat_of_num l) \<longleftrightarrow> HOL.equal k l"
huffman@47108
   112
  by (simp_all add: nat_of_num_numeral equal)
huffman@47108
   113
huffman@47108
   114
lemma equal_nat_refl [code nbe]:
huffman@47108
   115
  "HOL.equal (n::nat) n \<longleftrightarrow> True"
huffman@47108
   116
  by (rule equal_refl)
huffman@47108
   117
huffman@47108
   118
lemma [code, code del]:
huffman@47108
   119
  "(less_eq :: nat \<Rightarrow> _) = less_eq" ..
huffman@47108
   120
huffman@47108
   121
lemma less_eq_nat_code [code]:
huffman@47108
   122
  "0 \<le> (n::nat) \<longleftrightarrow> True"
huffman@47108
   123
  "nat_of_num k \<le> 0 \<longleftrightarrow> False"
huffman@47108
   124
  "nat_of_num k \<le> nat_of_num l \<longleftrightarrow> k \<le> l"
huffman@47108
   125
  by (simp_all add: nat_of_num_numeral)
huffman@47108
   126
huffman@47108
   127
lemma [code, code del]:
huffman@47108
   128
  "(less :: nat \<Rightarrow> _) = less" ..
huffman@47108
   129
huffman@47108
   130
lemma less_nat_code [code]:
huffman@47108
   131
  "(m::nat) < 0 \<longleftrightarrow> False"
huffman@47108
   132
  "0 < nat_of_num l \<longleftrightarrow> True"
huffman@47108
   133
  "nat_of_num k < nat_of_num l \<longleftrightarrow> k < l"
huffman@47108
   134
  by (simp_all add: nat_of_num_numeral)
huffman@47108
   135
haftmann@53069
   136
lemma [code, code del]:
haftmann@61433
   137
  "Divides.divmod_nat = Divides.divmod_nat" ..
haftmann@53069
   138
  
haftmann@53069
   139
lemma divmod_nat_code [code]:
haftmann@61433
   140
  "Divides.divmod_nat (nat_of_num k) (nat_of_num l) = divmod k l"
haftmann@61433
   141
  "Divides.divmod_nat m 0 = (0, m)"
haftmann@61433
   142
  "Divides.divmod_nat 0 n = (0, 0)"
haftmann@60868
   143
  by (simp_all add: prod_eq_iff nat_of_num_numeral)
haftmann@53069
   144
wenzelm@61115
   145
end
wenzelm@61115
   146
huffman@47108
   147
wenzelm@60500
   148
subsection \<open>Conversions\<close>
huffman@47108
   149
huffman@47108
   150
lemma [code, code del]:
huffman@47108
   151
  "of_nat = of_nat" ..
huffman@47108
   152
huffman@47108
   153
lemma of_nat_code [code]:
huffman@47108
   154
  "of_nat 0 = 0"
huffman@47108
   155
  "of_nat (nat_of_num k) = numeral k"
huffman@47108
   156
  by (simp_all add: nat_of_num_numeral)
huffman@47108
   157
huffman@47108
   158
haftmann@52435
   159
code_identifier
haftmann@52435
   160
  code_module Code_Binary_Nat \<rightharpoonup>
haftmann@52435
   161
    (SML) Arith and (OCaml) Arith and (Haskell) Arith
huffman@47108
   162
huffman@47108
   163
end