src/HOL/Tools/float_syntax.ML
author wenzelm
Fri, 13 May 2011 23:58:40 +0200
changeset 42795 66fcc9882784
parent 42290 b1f544c84040
child 46236 ae79f2978a67
permissions -rw-r--r--
clarified map_simpset versus Simplifier.map_simpset_global;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
37744
3daaf23b9ab4 tuned titles
haftmann
parents: 35123
diff changeset
     1
(*  Title:      HOL/Tools/float_syntax.ML
3daaf23b9ab4 tuned titles
haftmann
parents: 35123
diff changeset
     2
    Author:     Tobias Nipkow, TU Muenchen
28906
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
     3
35115
446c5063e4fd modernized translations;
wenzelm
parents: 32603
diff changeset
     4
Concrete syntax for floats.
28906
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
     5
*)
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
     6
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
     7
signature FLOAT_SYNTAX =
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
     8
sig
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
     9
  val setup: theory -> theory
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    10
end;
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    11
35123
e286d5df187a modernized structures;
wenzelm
parents: 35115
diff changeset
    12
structure Float_Syntax: FLOAT_SYNTAX =
28906
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    13
struct
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    14
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    15
(* parse translation *)
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    16
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    17
local
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    18
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    19
fun mk_number i =
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    20
  let
35115
446c5063e4fd modernized translations;
wenzelm
parents: 32603
diff changeset
    21
    fun mk 0 = Syntax.const @{const_syntax Int.Pls}
446c5063e4fd modernized translations;
wenzelm
parents: 32603
diff changeset
    22
      | mk ~1 = Syntax.const @{const_syntax Int.Min}
446c5063e4fd modernized translations;
wenzelm
parents: 32603
diff changeset
    23
      | mk i =
446c5063e4fd modernized translations;
wenzelm
parents: 32603
diff changeset
    24
          let val (q, r) = Integer.div_mod i 2
446c5063e4fd modernized translations;
wenzelm
parents: 32603
diff changeset
    25
          in HOLogic.mk_bit r $ (mk q) end;
446c5063e4fd modernized translations;
wenzelm
parents: 32603
diff changeset
    26
  in Syntax.const @{const_syntax Int.number_of} $ mk i end;
28906
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    27
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    28
fun mk_frac str =
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    29
  let
42290
b1f544c84040 discontinued special treatment of structure Lexicon;
wenzelm
parents: 37744
diff changeset
    30
    val {mant = i, exp = n} = Lexicon.read_float str;
35115
446c5063e4fd modernized translations;
wenzelm
parents: 32603
diff changeset
    31
    val exp = Syntax.const @{const_syntax Power.power};
28906
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    32
    val ten = mk_number 10;
35115
446c5063e4fd modernized translations;
wenzelm
parents: 32603
diff changeset
    33
    val exp10 = if n = 1 then ten else exp $ ten $ mk_number n;
446c5063e4fd modernized translations;
wenzelm
parents: 32603
diff changeset
    34
  in Syntax.const @{const_syntax divide} $ mk_number i $ exp10 end;
446c5063e4fd modernized translations;
wenzelm
parents: 32603
diff changeset
    35
28906
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    36
in
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    37
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    38
fun float_tr (*"_Float"*) [t as Const (str, _)] = mk_frac str
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    39
  | float_tr (*"_Float"*) ts = raise TERM ("float_tr", ts);
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    40
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    41
end;
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    42
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    43
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    44
(* theory setup *)
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    45
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    46
val setup =
35115
446c5063e4fd modernized translations;
wenzelm
parents: 32603
diff changeset
    47
  Sign.add_trfuns ([], [(@{syntax_const "_Float"}, float_tr)], [], []);
28906
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    48
5f568bfc58d7 Floats for Real.
nipkow
parents:
diff changeset
    49
end;