53 lines
1.4 KiB
Plaintext
53 lines
1.4 KiB
Plaintext
(*
|
|
* Copyright 2014, NICTA
|
|
*
|
|
* This software may be distributed and modified according to the terms of
|
|
* the BSD 2-Clause license. Note that NO WARRANTY is provided.
|
|
* See "LICENSE_BSD2.txt" for details.
|
|
*
|
|
* @TAG(NICTA_BSD)
|
|
*)
|
|
|
|
section "Print Words in Hex"
|
|
|
|
theory Hex_Words
|
|
imports
|
|
"HOL-Word.Word"
|
|
begin
|
|
|
|
text \<open>Print words in hex.\<close>
|
|
|
|
(* mostly clagged from Num.thy *)
|
|
typed_print_translation \<open>
|
|
let
|
|
fun dest_num (Const (@{const_syntax Num.Bit0}, _) $ n) = 2 * dest_num n
|
|
| dest_num (Const (@{const_syntax Num.Bit1}, _) $ n) = 2 * dest_num n + 1
|
|
| dest_num (Const (@{const_syntax Num.One}, _)) = 1;
|
|
|
|
fun dest_bin_hex_str tm =
|
|
let
|
|
val num = dest_num tm;
|
|
val pre = if num < 10 then "" else "0x"
|
|
in
|
|
pre ^ (Int.fmt StringCvt.HEX num)
|
|
end;
|
|
|
|
fun num_tr' sign ctxt T [n] =
|
|
let
|
|
val k = dest_bin_hex_str n;
|
|
val t' = Syntax.const @{syntax_const "_Numeral"} $
|
|
Syntax.free (sign ^ k);
|
|
in
|
|
case T of
|
|
Type (@{type_name fun}, [_, T' as Type("Word.word",_)]) =>
|
|
if not (Config.get ctxt show_types) andalso can Term.dest_Type T'
|
|
then t'
|
|
else Syntax.const @{syntax_const "_constrain"} $ t' $
|
|
Syntax_Phases.term_of_typ ctxt T'
|
|
| T' => if T' = dummyT then t' else raise Match
|
|
end;
|
|
in [(@{const_syntax numeral}, num_tr' "")] end
|
|
\<close>
|
|
|
|
end
|