src/HOL/Codegenerator_Test/Generate_Target_Bit_Operations.thy
author wenzelm
Mon, 03 Feb 2025 20:22:51 +0100
changeset 82073 879be333e939
parent 81999 513f8fa74c82
child 82445 bb1f2a03b370
permissions -rw-r--r--
merged
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
81999
513f8fa74c82 more explicit tests for non-PolyML SML platforms
haftmann
parents: 81818
diff changeset
    11
context
513f8fa74c82 more explicit tests for non-PolyML SML platforms
haftmann
parents: 81818
diff changeset
    12
  includes bit_operations_syntax
513f8fa74c82 more explicit tests for non-PolyML SML platforms
haftmann
parents: 81818
diff changeset
    13
begin
81714
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    14
81999
513f8fa74c82 more explicit tests for non-PolyML SML platforms
haftmann
parents: 81818
diff changeset
    15
qualified definition computations where
81714
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    16
  \<open>computations = (
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    17
    [bit (473514 :: integer) 5, bit (- 805167 :: integer) 7],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    18
    [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
    19
    [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
    20
    [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
    21
    [NOT 473513, NOT (- 805167) :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    22
    mask 39 :: integer,
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    23
    [set_bit 15 473514, set_bit 11 (- 805167) :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    24
    [unset_bit 13 473514, unset_bit 12 (- 805167) :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    25
    [flip_bit 15 473514, flip_bit 12 (- 805167) :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    26
    [push_bit 12 473514, push_bit 12 (- 805167) :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    27
    [drop_bit 12 473514, drop_bit 12 (- 805167) :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    28
    [take_bit 12 473514, take_bit 12 (- 805167) :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    29
    [signed_take_bit 12 473514, signed_take_bit 12 (- 805167) :: integer]
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    30
  )\<close>
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    31
81999
513f8fa74c82 more explicit tests for non-PolyML SML platforms
haftmann
parents: 81818
diff changeset
    32
qualified definition results where
81714
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    33
  \<open>results = (
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    34
    [True, True],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    35
    [208898, 242769, 209184, - 839103 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    36
    [1031679, - 280873, - 50197, - 280591 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    37
    [822781, - 523642, - 259381, 558512 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    38
    [- 473514, 805166 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    39
    549755813887 :: integer,
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    40
    [506282, - 803119 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    41
    [465322, - 809263 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    42
    [506282, - 809263 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    43
    [1939513344, - 3297964032 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    44
    [115, - 197 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    45
    [2474, 1745 :: integer],
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    46
    [- 1622, - 2351 :: integer]
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    47
  )\<close>
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    48
81999
513f8fa74c82 more explicit tests for non-PolyML SML platforms
haftmann
parents: 81818
diff changeset
    49
qualified definition check where
81714
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    50
  \<open>check \<longleftrightarrow> computations = results\<close>
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    51
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    52
lemma check
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    53
  by code_simp
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    54
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    55
lemma check
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    56
  by normalization
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    57
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    58
lemma check
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    59
  by eval
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    60
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
81999
513f8fa74c82 more explicit tests for non-PolyML SML platforms
haftmann
parents: 81818
diff changeset
    65
qualified definition \<open>check_max = ()\<close>
81814
d4eaefc626ec explicit check for (experimentally determined) border value
haftmann
parents: 81714
diff changeset
    66
81999
513f8fa74c82 more explicit tests for non-PolyML SML platforms
haftmann
parents: 81818
diff changeset
    67
qualified definition \<open>anchor = (Code_Target_Bit_Shifts.drop_bit, check_max)\<close>
513f8fa74c82 more explicit tests for non-PolyML SML platforms
haftmann
parents: 81818
diff changeset
    68
513f8fa74c82 more explicit tests for non-PolyML SML platforms
haftmann
parents: 81818
diff changeset
    69
end
81818
1085eb118dc7 restrict check to PolyML
haftmann
parents: 81814
diff changeset
    70
1085eb118dc7 restrict check to PolyML
haftmann
parents: 81814
diff changeset
    71
code_printing
1085eb118dc7 restrict check to PolyML
haftmann
parents: 81814
diff changeset
    72
    code_module Check_Max  \<rightharpoonup>
1085eb118dc7 restrict check to PolyML
haftmann
parents: 81814
diff changeset
    73
      (SML) \<open>
81814
d4eaefc626ec explicit check for (experimentally determined) border value
haftmann
parents: 81714
diff changeset
    74
fun check_max max =
d4eaefc626ec explicit check for (experimentally determined) border value
haftmann
parents: 81714
diff changeset
    75
  let
d4eaefc626ec explicit check for (experimentally determined) border value
haftmann
parents: 81714
diff changeset
    76
    val _ = IntInf.~>> (0, max);
81818
1085eb118dc7 restrict check to PolyML
haftmann
parents: 81814
diff changeset
    77
    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
    78
  in () end;
d4eaefc626ec explicit check for (experimentally determined) border value
haftmann
parents: 81714
diff changeset
    79
\<close>
81999
513f8fa74c82 more explicit tests for non-PolyML SML platforms
haftmann
parents: 81818
diff changeset
    80
  | constant Generate_Target_Bit_Operations.check_max \<rightharpoonup>
81818
1085eb118dc7 restrict check to PolyML
haftmann
parents: 81814
diff changeset
    81
      (SML) "check'_max Bit'_Shifts.word'_max'_index"
81814
d4eaefc626ec explicit check for (experimentally determined) border value
haftmann
parents: 81714
diff changeset
    82
81999
513f8fa74c82 more explicit tests for non-PolyML SML platforms
haftmann
parents: 81818
diff changeset
    83
test_code \<open>snd Generate_Target_Bit_Operations.anchor = ()\<close> in PolyML
81814
d4eaefc626ec explicit check for (experimentally determined) border value
haftmann
parents: 81714
diff changeset
    84
81714
5e3dd01a9eb2 separate theory for tests checking bit operations
haftmann
parents:
diff changeset
    85
end