author | hoelzl |
Thu, 17 Jan 2013 11:59:12 +0100 | |
changeset 50936 | b28f258ebc1a |
parent 48431 | 6efff142bb54 |
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:
39272
diff
changeset
|
12 |
Representation-ignorant code equations for conversions. |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
13 |
*} |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
14 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
15 |
lemma nat_code [code]: |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
16 |
"nat k = (if k \<le> 0 then 0 else |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
17 |
let |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
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:
47108
diff
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:
47108
diff
changeset
|
20 |
l' = n + n |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
21 |
in if j = 0 then l' else Suc l')" |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
22 |
proof - |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
23 |
have "2 = nat 2" by simp |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
24 |
show ?thesis |
47217
501b9bbd0d6e
removed redundant nat-specific copies of theorems
huffman
parents:
47125
diff
changeset
|
25 |
apply (subst mult_2 [symmetric]) |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
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:
39272
diff
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:
39272
diff
changeset
|
28 |
apply (unfold `2 = nat 2`) |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
29 |
apply (subst nat_mod_distrib [symmetric]) |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
30 |
apply simp_all |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
31 |
done |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
32 |
qed |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
33 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
34 |
lemma (in ring_1) of_int_code: |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
35 |
"of_int k = (if k = 0 then 0 |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
36 |
else if k < 0 then - of_int (- k) |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
37 |
else let |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
38 |
(l, j) = divmod_int k 2; |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
39 |
l' = 2 * of_int l |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
40 |
in if j = 0 then l' else l' + 1)" |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
41 |
proof - |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
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:
39272
diff
changeset
|
43 |
show ?thesis |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
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:
39272
diff
changeset
|
45 |
of_int_add [symmetric]) (simp add: * mult_commute) |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
46 |
qed |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
47 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
48 |
declare of_int_code [code] |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
49 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
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:
38773
diff
changeset
|
63 |
code_instance int :: equal |
24999 | 64 |
(Haskell -) |
65 |
||
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
66 |
code_const "0::int" |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
67 |
(SML "0") |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
68 |
(OCaml "Big'_int.zero'_big'_int") |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
69 |
(Haskell "0") |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
70 |
(Scala "BigInt(0)") |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
71 |
|
24999 | 72 |
setup {* |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
73 |
fold (Numeral.add_code @{const_name Int.Pos} |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
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:
39272
diff
changeset
|
77 |
setup {* |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
78 |
fold (Numeral.add_code @{const_name Int.Neg} |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
79 |
true Code_Printer.literal_numeral) ["SML", "OCaml", "Haskell", "Scala"] |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
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:
37947
diff
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:
37947
diff
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:
37947
diff
changeset
|
101 |
(Eval infixl 8 "-") |
24999 | 102 |
|
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
103 |
code_const Int.dup |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
104 |
(SML "IntInf.*/ (2,/ (_))") |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
105 |
(OCaml "Big'_int.mult'_big'_int/ 2") |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
106 |
(Haskell "!(2 * _)") |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
107 |
(Scala "!(2 * _)") |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
108 |
(Eval "!(2 * _)") |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
109 |
|
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
110 |
code_const Int.sub |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
111 |
(SML "!(raise/ Fail/ \"sub\")") |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
112 |
(OCaml "failwith/ \"sub\"") |
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
changeset
|
113 |
(Haskell "error/ \"sub\"") |
48073
1b609a7837ef
prefer sys.error over plain error in Scala to avoid deprecation warning
haftmann
parents:
47217
diff
changeset
|
114 |
(Scala "!sys.error(\"sub\")") |
47108
2a1953f0d20d
merged fork with new numeral representation (see NEWS)
huffman
parents:
39272
diff
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:
37947
diff
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:
34899
diff
changeset
|
126 |
(Haskell "divMod/ (abs _)/ (abs _)") |
37958
9728342bcd56
another refinement chapter in the neverending numeral story
haftmann
parents:
37947
diff
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:
37947
diff
changeset
|
128 |
(Eval "Integer.div'_mod/ (abs _)/ (abs _)") |
29936 | 129 |
|
38857
97775f3e8722
renamed class/constant eq to equal; tuned some instantiations
haftmann
parents:
38773
diff
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:
37947
diff
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:
37947
diff
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:
37947
diff
changeset
|
148 |
(Scala infixl 4 "<") |
9728342bcd56
another refinement chapter in the neverending numeral story
haftmann
parents:
37947
diff
changeset
|
149 |
(Eval infixl 6 "<") |
24999 | 150 |
|
31205
98370b26c2ce
String.literal replaces message_string, code_numeral replaces (code_)index
haftmann
parents:
31203
diff
changeset
|
151 |
code_const Code_Numeral.int_of |
31192 | 152 |
(SML "IntInf.fromInt") |
31377 | 153 |
(OCaml "_") |
48431
6efff142bb54
restrict unqualified imports from Haskell Prelude to a small set of fundamental operations
haftmann
parents:
48073
diff
changeset
|
154 |
(Haskell "Prelude.toInteger") |
37958
9728342bcd56
another refinement chapter in the neverending numeral story
haftmann
parents:
37947
diff
changeset
|
155 |
(Scala "!_.as'_BigInt") |
9728342bcd56
another refinement chapter in the neverending numeral story
haftmann
parents:
37947
diff
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:
39272
diff
changeset
|
161 |
end |