| author | wenzelm | 
| Thu, 24 May 2012 23:13:06 +0200 | |
| changeset 47996 | 25b9f59ab1b9 | 
| parent 47217 | 501b9bbd0d6e | 
| child 48073 | 1b609a7837ef | 
| permissions | -rw-r--r-- | 
| 24999 | 1 | (* Title: HOL/Library/Code_Integer.thy | 
| 2 | Author: Florian Haftmann, TU Muenchen | |
| 3 | *) | |
| 4 | ||
| 5 | header {* Pretty integer literals for code generation *}
 | |
| 6 | ||
| 7 | theory Code_Integer | |
| 37968 | 8 | imports Main Code_Natural | 
| 24999 | 9 | begin | 
| 10 | ||
| 11 | text {*
 | |
| 47108 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 12 | Representation-ignorant code equations for conversions. | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 13 | *} | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 14 | |
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 15 | lemma nat_code [code]: | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 16 | "nat k = (if k \<le> 0 then 0 else | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 17 | let | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 18 | (l, j) = divmod_int k 2; | 
| 47125 
a3a64240cd98
code lemma for function 'nat' that doesn't go into an infinite loop (fixes problem with non-terminating HOL-Proofs-Lambda)
 huffman parents: 
47108diff
changeset | 19 | n = nat l; | 
| 
a3a64240cd98
code lemma for function 'nat' that doesn't go into an infinite loop (fixes problem with non-terminating HOL-Proofs-Lambda)
 huffman parents: 
47108diff
changeset | 20 | l' = n + n | 
| 47108 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 21 | in if j = 0 then l' else Suc l')" | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 22 | proof - | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 23 | have "2 = nat 2" by simp | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 24 | show ?thesis | 
| 47217 
501b9bbd0d6e
removed redundant nat-specific copies of theorems
 huffman parents: 
47125diff
changeset | 25 | apply (subst mult_2 [symmetric]) | 
| 47108 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 26 | apply (auto simp add: Let_def divmod_int_mod_div not_le | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 27 | nat_div_distrib nat_mult_distrib mult_div_cancel mod_2_not_eq_zero_eq_one_int) | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 28 | apply (unfold `2 = nat 2`) | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 29 | apply (subst nat_mod_distrib [symmetric]) | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 30 | apply simp_all | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 31 | done | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 32 | qed | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 33 | |
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 34 | lemma (in ring_1) of_int_code: | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 35 | "of_int k = (if k = 0 then 0 | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 36 | else if k < 0 then - of_int (- k) | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 37 | else let | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 38 | (l, j) = divmod_int k 2; | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 39 | l' = 2 * of_int l | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 40 | in if j = 0 then l' else l' + 1)" | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 41 | proof - | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 42 | from mod_div_equality have *: "of_int k = of_int (k div 2 * 2 + k mod 2)" by simp | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 43 | show ?thesis | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 44 | by (simp add: Let_def divmod_int_mod_div mod_2_not_eq_zero_eq_one_int | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 45 | of_int_add [symmetric]) (simp add: * mult_commute) | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 46 | qed | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 47 | |
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 48 | declare of_int_code [code] | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 49 | |
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 50 | text {*
 | 
| 24999 | 51 | HOL numeral expressions are mapped to integer literals | 
| 52 | in target languages, using predefined target language | |
| 53 | operations for abstract integer operations. | |
| 54 | *} | |
| 55 | ||
| 56 | code_type int | |
| 57 | (SML "IntInf.int") | |
| 58 | (OCaml "Big'_int.big'_int") | |
| 59 | (Haskell "Integer") | |
| 34899 | 60 | (Scala "BigInt") | 
| 38053 | 61 | (Eval "int") | 
| 24999 | 62 | |
| 38857 
97775f3e8722
renamed class/constant eq to equal; tuned some instantiations
 haftmann parents: 
38773diff
changeset | 63 | code_instance int :: equal | 
| 24999 | 64 | (Haskell -) | 
| 65 | ||
| 47108 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 66 | code_const "0::int" | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 67 | (SML "0") | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 68 | (OCaml "Big'_int.zero'_big'_int") | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 69 | (Haskell "0") | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 70 | (Scala "BigInt(0)") | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 71 | |
| 24999 | 72 | setup {*
 | 
| 47108 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 73 |   fold (Numeral.add_code @{const_name Int.Pos}
 | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 74 | false Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"] | 
| 24999 | 75 | *} | 
| 76 | ||
| 47108 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 77 | setup {*
 | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 78 |   fold (Numeral.add_code @{const_name Int.Neg}
 | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 79 | true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"] | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 80 | *} | 
| 24999 | 81 | |
| 82 | code_const "op + \<Colon> int \<Rightarrow> int \<Rightarrow> int" | |
| 83 | (SML "IntInf.+ ((_), (_))") | |
| 84 | (OCaml "Big'_int.add'_big'_int") | |
| 85 | (Haskell infixl 6 "+") | |
| 34899 | 86 | (Scala infixl 7 "+") | 
| 37958 
9728342bcd56
another refinement chapter in the neverending numeral story
 haftmann parents: 
37947diff
changeset | 87 | (Eval infixl 8 "+") | 
| 24999 | 88 | |
| 89 | code_const "uminus \<Colon> int \<Rightarrow> int" | |
| 90 | (SML "IntInf.~") | |
| 91 | (OCaml "Big'_int.minus'_big'_int") | |
| 92 | (Haskell "negate") | |
| 34899 | 93 | (Scala "!(- _)") | 
| 37958 
9728342bcd56
another refinement chapter in the neverending numeral story
 haftmann parents: 
37947diff
changeset | 94 | (Eval "~/ _") | 
| 24999 | 95 | |
| 96 | code_const "op - \<Colon> int \<Rightarrow> int \<Rightarrow> int" | |
| 97 | (SML "IntInf.- ((_), (_))") | |
| 98 | (OCaml "Big'_int.sub'_big'_int") | |
| 99 | (Haskell infixl 6 "-") | |
| 34899 | 100 | (Scala infixl 7 "-") | 
| 37958 
9728342bcd56
another refinement chapter in the neverending numeral story
 haftmann parents: 
37947diff
changeset | 101 | (Eval infixl 8 "-") | 
| 24999 | 102 | |
| 47108 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 103 | code_const Int.dup | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 104 | (SML "IntInf.*/ (2,/ (_))") | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 105 | (OCaml "Big'_int.mult'_big'_int/ 2") | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 106 | (Haskell "!(2 * _)") | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 107 | (Scala "!(2 * _)") | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 108 | (Eval "!(2 * _)") | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 109 | |
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 110 | code_const Int.sub | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 111 | (SML "!(raise/ Fail/ \"sub\")") | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 112 | (OCaml "failwith/ \"sub\"") | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 113 | (Haskell "error/ \"sub\"") | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 114 | (Scala "!error(\"sub\")") | 
| 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 115 | |
| 24999 | 116 | code_const "op * \<Colon> int \<Rightarrow> int \<Rightarrow> int" | 
| 117 | (SML "IntInf.* ((_), (_))") | |
| 118 | (OCaml "Big'_int.mult'_big'_int") | |
| 119 | (Haskell infixl 7 "*") | |
| 34899 | 120 | (Scala infixl 8 "*") | 
| 37958 
9728342bcd56
another refinement chapter in the neverending numeral story
 haftmann parents: 
37947diff
changeset | 121 | (Eval infixl 9 "*") | 
| 24999 | 122 | |
| 29936 | 123 | code_const pdivmod | 
| 34899 | 124 | (SML "IntInf.divMod/ (IntInf.abs _,/ IntInf.abs _)") | 
| 125 | (OCaml "Big'_int.quomod'_big'_int/ (Big'_int.abs'_big'_int _)/ (Big'_int.abs'_big'_int _)") | |
| 34944 
970e1466028d
code literals: distinguish numeral classes by different entries
 haftmann parents: 
34899diff
changeset | 126 | (Haskell "divMod/ (abs _)/ (abs _)") | 
| 37958 
9728342bcd56
another refinement chapter in the neverending numeral story
 haftmann parents: 
37947diff
changeset | 127 | (Scala "!((k: BigInt) => (l: BigInt) =>/ if (l == 0)/ (BigInt(0), k) else/ (k.abs '/% l.abs))") | 
| 
9728342bcd56
another refinement chapter in the neverending numeral story
 haftmann parents: 
37947diff
changeset | 128 | (Eval "Integer.div'_mod/ (abs _)/ (abs _)") | 
| 29936 | 129 | |
| 38857 
97775f3e8722
renamed class/constant eq to equal; tuned some instantiations
 haftmann parents: 
38773diff
changeset | 130 | code_const "HOL.equal \<Colon> int \<Rightarrow> int \<Rightarrow> bool" | 
| 24999 | 131 | (SML "!((_ : IntInf.int) = _)") | 
| 132 | (OCaml "Big'_int.eq'_big'_int") | |
| 39272 | 133 | (Haskell infix 4 "==") | 
| 34899 | 134 | (Scala infixl 5 "==") | 
| 37958 
9728342bcd56
another refinement chapter in the neverending numeral story
 haftmann parents: 
37947diff
changeset | 135 | (Eval infixl 6 "=") | 
| 24999 | 136 | |
| 137 | code_const "op \<le> \<Colon> int \<Rightarrow> int \<Rightarrow> bool" | |
| 138 | (SML "IntInf.<= ((_), (_))") | |
| 139 | (OCaml "Big'_int.le'_big'_int") | |
| 140 | (Haskell infix 4 "<=") | |
| 34899 | 141 | (Scala infixl 4 "<=") | 
| 37958 
9728342bcd56
another refinement chapter in the neverending numeral story
 haftmann parents: 
37947diff
changeset | 142 | (Eval infixl 6 "<=") | 
| 24999 | 143 | |
| 144 | code_const "op < \<Colon> int \<Rightarrow> int \<Rightarrow> bool" | |
| 145 | (SML "IntInf.< ((_), (_))") | |
| 146 | (OCaml "Big'_int.lt'_big'_int") | |
| 147 | (Haskell infix 4 "<") | |
| 37958 
9728342bcd56
another refinement chapter in the neverending numeral story
 haftmann parents: 
37947diff
changeset | 148 | (Scala infixl 4 "<") | 
| 
9728342bcd56
another refinement chapter in the neverending numeral story
 haftmann parents: 
37947diff
changeset | 149 | (Eval infixl 6 "<") | 
| 24999 | 150 | |
| 31205 
98370b26c2ce
String.literal replaces message_string, code_numeral replaces (code_)index
 haftmann parents: 
31203diff
changeset | 151 | code_const Code_Numeral.int_of | 
| 31192 | 152 | (SML "IntInf.fromInt") | 
| 31377 | 153 | (OCaml "_") | 
| 37958 
9728342bcd56
another refinement chapter in the neverending numeral story
 haftmann parents: 
37947diff
changeset | 154 | (Haskell "toInteger") | 
| 
9728342bcd56
another refinement chapter in the neverending numeral story
 haftmann parents: 
37947diff
changeset | 155 | (Scala "!_.as'_BigInt") | 
| 
9728342bcd56
another refinement chapter in the neverending numeral story
 haftmann parents: 
37947diff
changeset | 156 | (Eval "_") | 
| 24999 | 157 | |
| 32657 | 158 | code_const "Code_Evaluation.term_of \<Colon> int \<Rightarrow> term" | 
| 31192 | 159 | (Eval "HOLogic.mk'_number/ HOLogic.intT") | 
| 28228 | 160 | |
| 47108 
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
 huffman parents: 
39272diff
changeset | 161 | end |