src/HOL/Library/word_setup.ML
author paulson
Tue Jun 28 15:27:45 2005 +0200 (2005-06-28)
changeset 16587 b34c8aa657a5
parent 16486 1a12cdb6ee6b
child 17876 b9c92f384109
permissions -rw-r--r--
Constant "If" is now local
skalberg@14494
     1
(*  Title:      HOL/Library/word_setup.ML
skalberg@14494
     2
    ID:         $Id$
skalberg@14494
     3
    Author:     Sebastian Skalberg (TU Muenchen)
paulson@15013
     4
paulson@15013
     5
comments containing lcp are the removal of fast_bv_of_nat.
skalberg@14494
     6
*)
skalberg@14494
     7
skalberg@14494
     8
local
skalberg@14494
     9
    fun is_const_bool (Const("True",_)) = true
skalberg@14494
    10
      | is_const_bool (Const("False",_)) = true
skalberg@14494
    11
      | is_const_bool _ = false
skalberg@14494
    12
    fun is_const_bit (Const("Word.bit.Zero",_)) = true
skalberg@14494
    13
      | is_const_bit (Const("Word.bit.One",_)) = true
skalberg@14494
    14
      | is_const_bit _ = false
paulson@15013
    15
    fun num_is_usable (Const("Numeral.Pls",_)) = true
paulson@15013
    16
      | num_is_usable (Const("Numeral.Min",_)) = false
paulson@15013
    17
      | num_is_usable (Const("Numeral.Bit",_) $ w $ b) =
skalberg@14494
    18
	num_is_usable w andalso is_const_bool b
skalberg@14494
    19
      | num_is_usable _ = false
skalberg@14494
    20
    fun vec_is_usable (Const("List.list.Nil",_)) = true
skalberg@14494
    21
      | vec_is_usable (Const("List.list.Cons",_) $ b $ bs) =
skalberg@14494
    22
	vec_is_usable bs andalso is_const_bit b
skalberg@14494
    23
      | vec_is_usable _ = false
skalberg@14494
    24
    fun add_word thy =
skalberg@14494
    25
	let
paulson@15013
    26
 (*lcp**	    val fast1_th = PureThy.get_thm thy "Word.fast_nat_to_bv_def"**)
wenzelm@16486
    27
	    val fast2_th = PureThy.get_thm thy (Name "Word.fast_bv_to_nat_def")
paulson@15013
    28
 (*lcp**	    fun f sg thms (Const("Word.nat_to_bv",_) $ (Const("Numeral.number_of",_) $ t)) =
skalberg@14494
    29
		if num_is_usable t
skalberg@15531
    30
		then SOME (Drule.cterm_instantiate [(cterm_of sg (Var(("w",0),Type("Numeral.bin",[]))),cterm_of sg t)] fast1_th)
skalberg@15531
    31
		else NONE
skalberg@15531
    32
	      | f _ _ _ = NONE **)
skalberg@14494
    33
	    fun g sg thms (Const("Word.bv_to_nat",_) $ (t as (Const("List.list.Cons",_) $ _ $ _))) =
skalberg@14494
    34
		if vec_is_usable t
skalberg@15531
    35
		then SOME (Drule.cterm_instantiate [(cterm_of sg (Var(("bs",0),Type("List.list",[Type("Word.bit",[])]))),cterm_of sg t)] fast2_th)
skalberg@15531
    36
		else NONE
skalberg@15531
    37
	      | g _ _ _ = NONE
paulson@15013
    38
  (*lcp**	    val simproc1 = Simplifier.simproc (sign_of thy) "nat_to_bv" ["Word.nat_to_bv (number_of ?w)"] f ***)
skalberg@14494
    39
	    val simproc2 = Simplifier.simproc (sign_of thy) "bv_to_nat" ["Word.bv_to_nat (?x # ?xs)"] g
skalberg@14494
    40
	in
paulson@15013
    41
	    Simplifier.change_simpset_of (op addsimprocs) [(*lcp*simproc1,**)simproc2] thy
skalberg@14494
    42
	end
skalberg@14494
    43
in
skalberg@14494
    44
val setup_word = [add_word]
skalberg@14494
    45
end