src/Tools/float.ML
author haftmann
Tue Jun 05 19:19:30 2007 +0200 (2007-06-05)
changeset 23261 85f27f79232f
parent 23251 471b576aad25
child 23297 06f108974fa1
permissions -rw-r--r--
tuned integers
haftmann@23251
     1
(*  Title:      Pure/General/float.ML
haftmann@23251
     2
    ID:         $Id$
haftmann@23251
     3
    Author:     Steven Obua, Florian Haftmann, TU Muenchen
haftmann@23251
     4
haftmann@23251
     5
Implementation of real numbers as mantisse-exponent pairs.
haftmann@23251
     6
*)
haftmann@23251
     7
haftmann@23251
     8
signature FLOAT =
haftmann@23251
     9
sig
haftmann@23261
    10
  type float = integer * integer
haftmann@23251
    11
  val zero: float
haftmann@23251
    12
  val eq: float * float -> bool
haftmann@23251
    13
  val cmp: float * float -> order
haftmann@23251
    14
  val cmp_zero: float -> order
haftmann@23251
    15
  val min: float -> float -> float
haftmann@23251
    16
  val max: float -> float -> float
haftmann@23251
    17
  val add: float -> float -> float
haftmann@23251
    18
  val sub: float -> float -> float
haftmann@23251
    19
  val neg: float -> float
haftmann@23251
    20
  val mult: float -> float -> float
haftmann@23251
    21
  val positive_part: float -> float
haftmann@23251
    22
  val negative_part: float -> float
haftmann@23251
    23
end;
haftmann@23251
    24
haftmann@23251
    25
structure Float : FLOAT =
haftmann@23251
    26
struct
haftmann@23251
    27
haftmann@23261
    28
type float = integer * integer;
haftmann@23251
    29
haftmann@23261
    30
val zero = (Integer.zero, Integer.zero);
haftmann@23251
    31
haftmann@23251
    32
fun add (a1, b1) (a2, b2) =
haftmann@23261
    33
  if Integer.cmp (b1, b2) = LESS then
haftmann@23261
    34
    (a1 +% a2 *% Integer.exp (b2 -% b1), b1)
haftmann@23251
    35
  else
haftmann@23261
    36
    (a1 *% Integer.exp (b1 -% b2) +% a2, b2);
haftmann@23251
    37
haftmann@23251
    38
fun sub (a1, b1) (a2, b2) =
haftmann@23261
    39
  if Integer.cmp (b1, b2) = LESS then
haftmann@23261
    40
    (a1 -% a2 *% Integer.exp (b2 -% b1), b1)
haftmann@23251
    41
  else
haftmann@23261
    42
    (a1 *% Integer.exp (b1 -% b2) -% a2, b2);
haftmann@23251
    43
haftmann@23261
    44
fun neg (a, b) = (Integer.neg a, b);
haftmann@23251
    45
haftmann@23261
    46
fun mult (a1, b1) (a2, b2) = (a1 *% a2, b1 +% b2);
haftmann@23251
    47
haftmann@23261
    48
fun cmp_zero (a, b) = Integer.cmp_zero a;
haftmann@23251
    49
haftmann@23251
    50
fun cmp (r, s) = cmp_zero (sub r s);
haftmann@23251
    51
haftmann@23251
    52
fun eq (r, s) = cmp (r, s) = EQUAL;
haftmann@23251
    53
haftmann@23251
    54
fun min r s = case cmp (r, s) of LESS => r | _ => s;
haftmann@23251
    55
fun max r s = case cmp (r, s) of LESS => s | _ => r;
haftmann@23251
    56
haftmann@23261
    57
fun positive_part (a, b) = (Integer.max Integer.zero a, b);
haftmann@23261
    58
fun negative_part (a, b) = (Integer.min Integer.zero a, b);
haftmann@23251
    59
haftmann@23251
    60
end;