author | haftmann |
Thu, 16 Jan 2025 18:07:31 +0100 | |
changeset 81818 | 1085eb118dc7 |
parent 81814 | d4eaefc626ec |
child 81999 | 513f8fa74c82 |
permissions | -rw-r--r-- |
81714 | 1 |
(* Author: Florian Haftmann, TU Muenchen *) |
2 |
||
3 |
section \<open>Test of target-language bit operations\<close> |
|
4 |
||
5 |
theory Generate_Target_Bit_Operations |
|
6 |
imports |
|
7 |
"HOL-Library.Code_Test" |
|
8 |
"HOL-Library.Code_Target_Bit_Shifts" |
|
9 |
begin |
|
10 |
||
11 |
unbundle bit_operations_syntax |
|
12 |
||
13 |
definition computations where |
|
14 |
\<open>computations = ( |
|
15 |
[bit (473514 :: integer) 5, bit (- 805167 :: integer) 7], |
|
16 |
[473514 AND 767063, - 805167 AND 767063, 473514 AND - 314527, - 805167 AND - 314527 :: integer], |
|
17 |
[473514 OR 767063, - 805167 OR 767063, 473514 OR - 314527, - 805167 OR - 314527 :: integer], |
|
18 |
[473514 XOR 767063, - 805167 XOR 767063, 473514 XOR - 314527, - 805167 XOR - 314527 :: integer], |
|
19 |
[NOT 473513, NOT (- 805167) :: integer], |
|
20 |
mask 39 :: integer, |
|
21 |
[set_bit 15 473514, set_bit 11 (- 805167) :: integer], |
|
22 |
[unset_bit 13 473514, unset_bit 12 (- 805167) :: integer], |
|
23 |
[flip_bit 15 473514, flip_bit 12 (- 805167) :: integer], |
|
24 |
[push_bit 12 473514, push_bit 12 (- 805167) :: integer], |
|
25 |
[drop_bit 12 473514, drop_bit 12 (- 805167) :: integer], |
|
26 |
[take_bit 12 473514, take_bit 12 (- 805167) :: integer], |
|
27 |
[signed_take_bit 12 473514, signed_take_bit 12 (- 805167) :: integer] |
|
28 |
)\<close> |
|
29 |
||
30 |
definition results where |
|
31 |
\<open>results = ( |
|
32 |
[True, True], |
|
33 |
[208898, 242769, 209184, - 839103 :: integer], |
|
34 |
[1031679, - 280873, - 50197, - 280591 :: integer], |
|
35 |
[822781, - 523642, - 259381, 558512 :: integer], |
|
36 |
[- 473514, 805166 :: integer], |
|
37 |
549755813887 :: integer, |
|
38 |
[506282, - 803119 :: integer], |
|
39 |
[465322, - 809263 :: integer], |
|
40 |
[506282, - 809263 :: integer], |
|
41 |
[1939513344, - 3297964032 :: integer], |
|
42 |
[115, - 197 :: integer], |
|
43 |
[2474, 1745 :: integer], |
|
44 |
[- 1622, - 2351 :: integer] |
|
45 |
)\<close> |
|
46 |
||
47 |
definition check where |
|
48 |
\<open>check \<longleftrightarrow> computations = results\<close> |
|
49 |
||
50 |
lemma check |
|
51 |
by code_simp |
|
52 |
||
53 |
lemma check |
|
54 |
by normalization |
|
55 |
||
56 |
lemma check |
|
57 |
by eval |
|
58 |
||
59 |
test_code check in OCaml |
|
60 |
test_code check in GHC |
|
61 |
test_code check in Scala |
|
62 |
||
81818 | 63 |
text \<open>Checking the index maximum for \<text>\<open>PolyML\<close>\<close> |
64 |
||
65 |
definition \<open>check_max = ()\<close> |
|
81814
d4eaefc626ec
explicit check for (experimentally determined) border value
haftmann
parents:
81714
diff
changeset
|
66 |
|
81818 | 67 |
definition \<open>anchor = (Code_Target_Bit_Shifts.drop_bit, check_max)\<close> |
68 |
||
69 |
code_printing |
|
70 |
code_module Check_Max \<rightharpoonup> |
|
71 |
(SML) \<open> |
|
81814
d4eaefc626ec
explicit check for (experimentally determined) border value
haftmann
parents:
81714
diff
changeset
|
72 |
fun check_max max = |
d4eaefc626ec
explicit check for (experimentally determined) border value
haftmann
parents:
81714
diff
changeset
|
73 |
let |
d4eaefc626ec
explicit check for (experimentally determined) border value
haftmann
parents:
81714
diff
changeset
|
74 |
val _ = IntInf.~>> (0, max); |
81818 | 75 |
val _ = ((IntInf.~>> (0, Word.+ (max, Word.fromInt 1)); raise Fail "Bad max") handle Size => ()) |
81814
d4eaefc626ec
explicit check for (experimentally determined) border value
haftmann
parents:
81714
diff
changeset
|
76 |
in () end; |
d4eaefc626ec
explicit check for (experimentally determined) border value
haftmann
parents:
81714
diff
changeset
|
77 |
\<close> |
81818 | 78 |
| constant check_max \<rightharpoonup> |
79 |
(SML) "check'_max Bit'_Shifts.word'_max'_index" |
|
81814
d4eaefc626ec
explicit check for (experimentally determined) border value
haftmann
parents:
81714
diff
changeset
|
80 |
|
81818 | 81 |
test_code \<open>snd anchor = ()\<close> in PolyML |
81814
d4eaefc626ec
explicit check for (experimentally determined) border value
haftmann
parents:
81714
diff
changeset
|
82 |
|
81714 | 83 |
end |