src/HOL/Word/Tools/word_lib.ML
author Thomas Sewell <thomas.sewell@nicta.com.au>
Tue, 17 Apr 2012 16:21:47 +1000
changeset 47567 407cabf66f21
child 59806 d3d4ec6c21ef
permissions -rw-r--r--
New tactic "word_bitwise" expands word equalities/inequalities into logic.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
47567
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
     1
(*  Title:      HOL/Word/Tools/word_lib.ML
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
     2
    Author:     Sascha Boehme, TU Muenchen and Thomas Sewell, NICTA
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
     3
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
     4
Helper routines for operating on the word type at the ML level.
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
     5
*)
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
     6
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
     7
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
     8
structure Word_Lib = struct
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
     9
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    10
fun dest_binT T =
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    11
  (case T of
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    12
    Type (@{type_name "Numeral_Type.num0"}, _) => 0
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    13
  | Type (@{type_name "Numeral_Type.num1"}, _) => 1
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    14
  | Type (@{type_name "Numeral_Type.bit0"}, [T]) => 2 * dest_binT T
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    15
  | Type (@{type_name "Numeral_Type.bit1"}, [T]) => 1 + 2 * dest_binT T
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    16
  | _ => raise TYPE ("dest_binT", [T], []))
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    17
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    18
fun is_wordT (Type (@{type_name word}, _)) = true
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    19
  | is_wordT _ = false
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    20
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    21
fun dest_wordT (Type (@{type_name word}, [T])) = dest_binT T
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    22
  | dest_wordT T = raise TYPE ("dest_wordT", [T], [])
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    23
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    24
local
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    25
  fun mk_bitT i T =
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    26
    if i = 0
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    27
    then Type (@{type_name "Numeral_Type.bit0"}, [T])
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    28
    else Type (@{type_name "Numeral_Type.bit1"}, [T])
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    29
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    30
  fun mk_binT size = 
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    31
    if size = 0 then @{typ "Numeral_Type.num0"}
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    32
    else if size = 1 then @{typ "Numeral_Type.num1"}
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    33
    else let val (q, r) = Integer.div_mod size 2 in mk_bitT r (mk_binT q) end
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    34
in
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    35
fun mk_wordT size =
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    36
  if size >= 0 then Type (@{type_name "word"}, [mk_binT size])
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    37
  else raise TYPE ("mk_wordT: " ^ quote (string_of_int size), [], [])
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    38
end
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    39
407cabf66f21 New tactic "word_bitwise" expands word equalities/inequalities into logic.
Thomas Sewell <thomas.sewell@nicta.com.au>
parents:
diff changeset
    40
end