src/HOL/Codegenerator_Test/Generate_Target_Bit_Operations.thy
author haftmann
Thu, 16 Jan 2025 18:07:31 +0100
changeset 81818 1085eb118dc7
parent 81814 d4eaefc626ec
child 81999 513f8fa74c82
permissions -rw-r--r--
restrict check to PolyML
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
81714
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
     1
(* Author: Florian Haftmann, TU Muenchen *)
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
     2
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
     3
section \<open>Test of target-language bit operations\<close>
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
     4
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
     5
theory Generate_Target_Bit_Operations
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
     6
imports
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
     7
  "HOL-Library.Code_Test"
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
     8
  "HOL-Library.Code_Target_Bit_Shifts"
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
     9
begin
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    10
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    11
unbundle bit_operations_syntax
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    12
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    13
definition computations where
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    14
  \<open>computations = (
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    15
    [bit (473514 :: integer) 5, bit (- 805167 :: integer) 7],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    16
    [473514 AND 767063, - 805167 AND 767063, 473514 AND - 314527, - 805167 AND - 314527 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    17
    [473514 OR 767063, - 805167 OR 767063, 473514 OR - 314527, - 805167 OR - 314527 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    18
    [473514 XOR 767063, - 805167 XOR 767063, 473514 XOR - 314527, - 805167 XOR - 314527 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    19
    [NOT 473513, NOT (- 805167) :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    20
    mask 39 :: integer,
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    21
    [set_bit 15 473514, set_bit 11 (- 805167) :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    22
    [unset_bit 13 473514, unset_bit 12 (- 805167) :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    23
    [flip_bit 15 473514, flip_bit 12 (- 805167) :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    24
    [push_bit 12 473514, push_bit 12 (- 805167) :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    25
    [drop_bit 12 473514, drop_bit 12 (- 805167) :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    26
    [take_bit 12 473514, take_bit 12 (- 805167) :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    27
    [signed_take_bit 12 473514, signed_take_bit 12 (- 805167) :: integer]
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    28
  )\<close>
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    29
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    30
definition results where
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    31
  \<open>results = (
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    32
    [True, True],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    33
    [208898, 242769, 209184, - 839103 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    34
    [1031679, - 280873, - 50197, - 280591 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    35
    [822781, - 523642, - 259381, 558512 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    36
    [- 473514, 805166 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    37
    549755813887 :: integer,
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    38
    [506282, - 803119 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    39
    [465322, - 809263 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    40
    [506282, - 809263 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    41
    [1939513344, - 3297964032 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    42
    [115, - 197 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    43
    [2474, 1745 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    44
    [- 1622, - 2351 :: integer]
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    45
  )\<close>
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    46
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    47
definition check where
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    48
  \<open>check \<longleftrightarrow> computations = results\<close>
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    49
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    50
lemma check
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    51
  by code_simp
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    52
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    53
lemma check
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    54
  by normalization
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    55
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    56
lemma check
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    57
  by eval
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    58
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    59
test_code check in OCaml
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    60
test_code check in GHC
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    61
test_code check in Scala
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    62
81818
1085eb118dc7 restrict check to PolyML
haftmann
parents: 81814
diff changeset
    63
text \<open>Checking the index maximum for \<text>\<open>PolyML\<close>\<close>
1085eb118dc7 restrict check to PolyML
haftmann
parents: 81814
diff changeset
    64
1085eb118dc7 restrict check to PolyML
haftmann
parents: 81814
diff changeset
    65
definition \<open>check_max = ()\<close>
81814
d4eaefc626ec explicit check for (experimentally determined) border value
haftmann
parents: 81714
diff changeset
    66
81818
1085eb118dc7 restrict check to PolyML
haftmann
parents: 81814
diff changeset
    67
definition \<open>anchor = (Code_Target_Bit_Shifts.drop_bit, check_max)\<close>
1085eb118dc7 restrict check to PolyML
haftmann
parents: 81814
diff changeset
    68
1085eb118dc7 restrict check to PolyML
haftmann
parents: 81814
diff changeset
    69
code_printing
1085eb118dc7 restrict check to PolyML
haftmann
parents: 81814
diff changeset
    70
    code_module Check_Max  \<rightharpoonup>
1085eb118dc7 restrict check to PolyML
haftmann
parents: 81814
diff changeset
    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
1085eb118dc7 restrict check to PolyML
haftmann
parents: 81814
diff changeset
    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
1085eb118dc7 restrict check to PolyML
haftmann
parents: 81814
diff changeset
    78
  | constant check_max \<rightharpoonup>
1085eb118dc7 restrict check to PolyML
haftmann
parents: 81814
diff changeset
    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
1085eb118dc7 restrict check to PolyML
haftmann
parents: 81814
diff changeset
    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
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    83
end