src/HOL/Word/Bit_Comprehension.thy
author haftmann
Mon, 06 Jul 2020 10:47:30 +0000
changeset 72000 379d0c207c29
parent 70192 b4bf82ed0ad5
child 72027 759532ef0885
permissions -rw-r--r--
separation of traditional bit operations
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
70192
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
     1
(*  Title:      HOL/Word/Bit_Comprehension.thy
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
     2
    Author:     Brian Huffman, PSU; Jeremy Dawson and Gerwin Klein, NICTA
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
     3
*)
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
     4
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
     5
section \<open>Comprehension syntax for bit expressions\<close>
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
     6
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
     7
theory Bit_Comprehension
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
     8
  imports Bits_Int
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
     9
begin
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    10
72000
379d0c207c29 separation of traditional bit operations
haftmann
parents: 70192
diff changeset
    11
class bit_comprehension = semiring_bits +
70192
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    12
  fixes set_bits :: "(nat \<Rightarrow> bool) \<Rightarrow> 'a"  (binder "BITS " 10)
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    13
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    14
instantiation int :: bit_comprehension
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    15
begin
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    16
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    17
definition
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    18
  "set_bits f =
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    19
    (if \<exists>n. \<forall>n'\<ge>n. \<not> f n' then
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    20
      let n = LEAST n. \<forall>n'\<ge>n. \<not> f n'
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    21
      in bl_to_bin (rev (map f [0..<n]))
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    22
     else if \<exists>n. \<forall>n'\<ge>n. f n' then
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    23
      let n = LEAST n. \<forall>n'\<ge>n. f n'
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    24
      in sbintrunc n (bl_to_bin (True # rev (map f [0..<n])))
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    25
     else 0 :: int)"
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    26
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    27
instance ..
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    28
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    29
end
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    30
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    31
lemma int_set_bits_K_False [simp]: "(BITS _. False) = (0 :: int)"
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    32
  by (simp add: set_bits_int_def)
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    33
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    34
lemma int_set_bits_K_True [simp]: "(BITS _. True) = (-1 :: int)"
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    35
  by (auto simp add: set_bits_int_def bl_to_bin_def)
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    36
b4bf82ed0ad5 separate type class for bit comprehension
haftmann
parents:
diff changeset
    37
end