src/HOL/Library/Code_Binary_Nat.thy
author Andreas Lochbihler
Wed Feb 27 10:33:30 2013 +0100 (2013-02-27)
changeset 51288 be7e9a675ec9
parent 51143 0a2371e7ced3
child 52435 6646bb548c6b
permissions -rw-r--r--
add wellorder instance for Numeral_Type (suggested by Jesus Aransay)
haftmann@50023
     1
(*  Title:      HOL/Library/Code_Binary_Nat.thy
haftmann@51113
     2
    Author:     Florian Haftmann, TU Muenchen
huffman@47108
     3
*)
huffman@47108
     4
huffman@47108
     5
header {* Implementation of natural numbers as binary numerals *}
huffman@47108
     6
haftmann@50023
     7
theory Code_Binary_Nat
haftmann@51113
     8
imports Code_Abstract_Nat
huffman@47108
     9
begin
huffman@47108
    10
huffman@47108
    11
text {*
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.
huffman@47108
    18
*}
huffman@47108
    19
huffman@47108
    20
subsection {* Representation *}
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
huffman@47108
    41
subsection {* Basic arithmetic *}
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
huffman@47108
    52
text {* Bounded subtraction needs some auxiliary *}
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"
huffman@47108
    71
  "sub (Num.Bit0 m) (Num.Bit0 n) = Option.map dup (sub m n)"
huffman@47108
    72
  "sub (Num.Bit1 m) (Num.Bit1 n) = Option.map dup (sub m n)"
huffman@47108
    73
  "sub (Num.Bit1 m) (Num.Bit0 n) = Option.map (\<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
huffman@47108
   133
huffman@47108
   134
subsection {* Conversions *}
huffman@47108
   135
huffman@47108
   136
lemma [code, code del]:
huffman@47108
   137
  "of_nat = of_nat" ..
huffman@47108
   138
huffman@47108
   139
lemma of_nat_code [code]:
huffman@47108
   140
  "of_nat 0 = 0"
huffman@47108
   141
  "of_nat (nat_of_num k) = numeral k"
huffman@47108
   142
  by (simp_all add: nat_of_num_numeral)
huffman@47108
   143
huffman@47108
   144
huffman@47108
   145
code_modulename SML
haftmann@50023
   146
  Code_Binary_Nat Arith
huffman@47108
   147
huffman@47108
   148
code_modulename OCaml
haftmann@50023
   149
  Code_Binary_Nat Arith
huffman@47108
   150
huffman@47108
   151
code_modulename Haskell
haftmann@50023
   152
  Code_Binary_Nat Arith
huffman@47108
   153
huffman@47108
   154
hide_const (open) dup sub
huffman@47108
   155
huffman@47108
   156
end
haftmann@50023
   157