src/HOL/Word/BitSyntax.thy
author wenzelm
Wed, 19 Dec 2007 16:52:07 +0100
changeset 25708 a7341f8ddf89
parent 25382 72cfe89f7b21
child 25762 c03e9d04b3e4
permissions -rw-r--r--
marked refute (the main metis procedure) as CRITICAL;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
24334
22863f364531 added header
kleing
parents: 24333
diff changeset
     1
(* 
22863f364531 added header
kleing
parents: 24333
diff changeset
     2
  ID:     $Id$
22863f364531 added header
kleing
parents: 24333
diff changeset
     3
  Author: Brian Huffman, PSU and Gerwin Klein, NICTA
22863f364531 added header
kleing
parents: 24333
diff changeset
     4
22863f364531 added header
kleing
parents: 24333
diff changeset
     5
  Syntactic class for bitwise operations.
22863f364531 added header
kleing
parents: 24333
diff changeset
     6
*)
22863f364531 added header
kleing
parents: 24333
diff changeset
     7
22863f364531 added header
kleing
parents: 24333
diff changeset
     8
24333
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
     9
header {* Syntactic class for bitwise operations *}
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    10
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    11
theory BitSyntax
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    12
imports Main
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    13
begin
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    14
24352
eda777a2785b use class instead of axclass
huffman
parents: 24334
diff changeset
    15
class bit = type +
eda777a2785b use class instead of axclass
huffman
parents: 24334
diff changeset
    16
  fixes bitNOT :: "'a \<Rightarrow> 'a"
eda777a2785b use class instead of axclass
huffman
parents: 24334
diff changeset
    17
    and bitAND :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
eda777a2785b use class instead of axclass
huffman
parents: 24334
diff changeset
    18
    and bitOR  :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
eda777a2785b use class instead of axclass
huffman
parents: 24334
diff changeset
    19
    and bitXOR :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
24333
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    20
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    21
text {*
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    22
  We want the bitwise operations to bind slightly weaker
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    23
  than @{text "+"} and @{text "-"}, but @{text "~~"} to 
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    24
  bind slightly stronger than @{text "*"}.
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    25
*}
24352
eda777a2785b use class instead of axclass
huffman
parents: 24334
diff changeset
    26
eda777a2785b use class instead of axclass
huffman
parents: 24334
diff changeset
    27
notation
25382
72cfe89f7b21 tuned specifications of 'notation';
wenzelm
parents: 24366
diff changeset
    28
  bitNOT  ("NOT _" [70] 71) and
72cfe89f7b21 tuned specifications of 'notation';
wenzelm
parents: 24366
diff changeset
    29
  bitAND  (infixr "AND" 64) and
72cfe89f7b21 tuned specifications of 'notation';
wenzelm
parents: 24366
diff changeset
    30
  bitOR   (infixr "OR"  59) and
24352
eda777a2785b use class instead of axclass
huffman
parents: 24334
diff changeset
    31
  bitXOR  (infixr "XOR" 59)
24333
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    32
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    33
text {*
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    34
  Testing and shifting operations.
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    35
*}
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    36
consts
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    37
  test_bit :: "'a::bit \<Rightarrow> nat \<Rightarrow> bool" (infixl "!!" 100)
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    38
  lsb      :: "'a::bit \<Rightarrow> bool"
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    39
  msb      :: "'a::bit \<Rightarrow> bool"
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    40
  set_bit  :: "'a::bit \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> 'a"
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    41
  set_bits :: "(nat \<Rightarrow> bool) \<Rightarrow> 'a::bit" (binder "BITS " 10)
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    42
  shiftl   :: "'a::bit \<Rightarrow> nat \<Rightarrow> 'a" (infixl "<<" 55)
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    43
  shiftr   :: "'a::bit \<Rightarrow> nat \<Rightarrow> 'a" (infixl ">>" 55)
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    44
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    45
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    46
subsection {* Bitwise operations on type @{typ bit} *}
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    47
24352
eda777a2785b use class instead of axclass
huffman
parents: 24334
diff changeset
    48
instance bit :: bit
24333
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    49
  NOT_bit_def: "NOT x \<equiv> case x of bit.B0 \<Rightarrow> bit.B1 | bit.B1 \<Rightarrow> bit.B0"
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    50
  AND_bit_def: "x AND y \<equiv> case x of bit.B0 \<Rightarrow> bit.B0 | bit.B1 \<Rightarrow> y"
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    51
  OR_bit_def: "x OR y :: bit \<equiv> NOT (NOT x AND NOT y)"
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    52
  XOR_bit_def: "x XOR y :: bit \<equiv> (x AND NOT y) OR (NOT x AND y)"
24352
eda777a2785b use class instead of axclass
huffman
parents: 24334
diff changeset
    53
  ..
24333
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    54
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    55
lemma bit_simps [simp]:
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    56
  "NOT bit.B0 = bit.B1"
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    57
  "NOT bit.B1 = bit.B0"
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    58
  "bit.B0 AND y = bit.B0"
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    59
  "bit.B1 AND y = y"
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    60
  "bit.B0 OR y = y"
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    61
  "bit.B1 OR y = bit.B1"
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    62
  "bit.B0 XOR y = y"
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    63
  "bit.B1 XOR y = NOT y"
24334
22863f364531 added header
kleing
parents: 24333
diff changeset
    64
  by (simp_all add: NOT_bit_def AND_bit_def OR_bit_def
22863f364531 added header
kleing
parents: 24333
diff changeset
    65
                    XOR_bit_def split: bit.split)
24333
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    66
24366
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    67
lemma bit_extra_simps [simp]: 
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    68
  "x AND bit.B0 = bit.B0"
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    69
  "x AND bit.B1 = x"
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    70
  "x OR bit.B1 = bit.B1"
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    71
  "x OR bit.B0 = x"
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    72
  "x XOR bit.B1 = NOT x"
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    73
  "x XOR bit.B0 = x"
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    74
  by (cases x, auto)+
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    75
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    76
lemma bit_ops_comm: 
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    77
  "(x::bit) AND y = y AND x"
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    78
  "(x::bit) OR y = y OR x"
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    79
  "(x::bit) XOR y = y XOR x"
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    80
  by (cases y, auto)+
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    81
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    82
lemma bit_ops_same [simp]: 
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    83
  "(x::bit) AND x = x"
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    84
  "(x::bit) OR x = x"
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    85
  "(x::bit) XOR x = bit.B0"
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    86
  by (cases x, auto)+
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    87
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    88
lemma bit_not_not [simp]: "NOT (NOT (x::bit)) = x"
08b116049547 move bit simps from BinOperations to BitSyntax
huffman
parents: 24352
diff changeset
    89
  by (cases x) auto
24333
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    90
e77ea0ea7f2c * HOL-Word:
kleing
parents:
diff changeset
    91
end