src/HOL/Tools/numeral_syntax.ML
changeset 29316 0a7fcdd77f4b
parent 26086 3c243098b64a
child 35115 446c5063e4fd
     1.1 --- a/src/HOL/Tools/numeral_syntax.ML	Fri Jan 02 16:21:47 2009 +0100
     1.2 +++ b/src/HOL/Tools/numeral_syntax.ML	Fri Jan 02 19:29:18 2009 +0100
     1.3 @@ -1,5 +1,4 @@
     1.4  (*  Title:      HOL/Tools/numeral_syntax.ML
     1.5 -    ID:         $Id$
     1.6      Authors:    Markus Wenzel, TU Muenchen
     1.7  
     1.8  Concrete syntax for generic numerals -- preserves leading zeros/ones.
     1.9 @@ -19,12 +18,11 @@
    1.10  
    1.11  fun mk_bin num =
    1.12    let
    1.13 -    val {leading_zeros = z, value, ...} = Syntax.read_xnum num;
    1.14      fun bit b bs = HOLogic.mk_bit b $ bs;
    1.15 -    fun mk 0 = (* FIXME funpow z (bit 0) *) (Syntax.const @{const_name Int.Pls})
    1.16 -      | mk ~1 = (* FIXME funpow z (bit 1) *) (Syntax.const @{const_name Int.Min})
    1.17 +    fun mk 0 = Syntax.const @{const_name Int.Pls}
    1.18 +      | mk ~1 = Syntax.const @{const_name Int.Min}
    1.19        | mk i = let val (q, r) = Integer.div_mod i 2 in bit r (mk q) end;
    1.20 -  in mk value end;
    1.21 +  in mk (#value (Syntax.read_xnum num)) end;
    1.22  
    1.23  in
    1.24  
    1.25 @@ -65,15 +63,18 @@
    1.26      else sign ^ implode (replicate z "0") ^ num
    1.27    end;
    1.28  
    1.29 +fun syntax_numeral t =
    1.30 +  Syntax.const "_Numeral" $ (Syntax.const "_numeral" $ Syntax.free (dest_bin_str t));
    1.31 +
    1.32  in
    1.33  
    1.34  fun numeral_tr' show_sorts (*"number_of"*) (Type ("fun", [_, T])) (t :: ts) =
    1.35 -      let val t' = Syntax.const "_Numeral" $ Syntax.free (dest_bin_str t) in
    1.36 -        if not (! show_types) andalso can Term.dest_Type T then t'
    1.37 -        else Syntax.const Syntax.constrainC $ t' $ Syntax.term_of_typ show_sorts T
    1.38 -      end
    1.39 +      let val t' =
    1.40 +        if not (! show_types) andalso can Term.dest_Type T then syntax_numeral t
    1.41 +        else Syntax.const Syntax.constrainC $ syntax_numeral t $ Syntax.term_of_typ show_sorts T
    1.42 +      in list_comb (t', ts) end
    1.43    | numeral_tr' _ (*"number_of"*) T (t :: ts) =
    1.44 -      if T = dummyT then Syntax.const "_Numeral" $ Syntax.free (dest_bin_str t)
    1.45 +      if T = dummyT then list_comb (syntax_numeral t, ts)
    1.46        else raise Match
    1.47    | numeral_tr' _ (*"number_of"*) _ _ = raise Match;
    1.48