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