| author | wenzelm | 
| Sat, 15 Dec 2012 16:59:33 +0100 | |
| changeset 50551 | 67d934cdc9b9 | 
| 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  |