src/Tools/float.ML
author blanchet
Tue, 07 Dec 2010 11:56:01 +0100
changeset 41051 2ed1b971fc20
parent 30161 c26e515f1c29
child 67560 0fa87bd86566
permissions -rw-r--r--
give the inner timeout mechanism a chance, since it gives more precise information to the user
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
24584
01e83ffa6c54 fixed title
haftmann
parents: 23520
diff changeset
     1
(*  Title:      Tools/float.ML
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
     2
    Author:     Steven Obua, Florian Haftmann, TU Muenchen
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
     3
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
     4
Implementation of real numbers as mantisse-exponent pairs.
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
     5
*)
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
     6
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
     7
signature FLOAT =
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
     8
sig
24630
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
     9
  type float = int * int
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    10
  val zero: float
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    11
  val eq: float * float -> bool
23520
483fe92f00c1 tuned arithmetic modules
haftmann
parents: 23297
diff changeset
    12
  val ord: float * float -> order
483fe92f00c1 tuned arithmetic modules
haftmann
parents: 23297
diff changeset
    13
  val sign: float -> order
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    14
  val min: float -> float -> float
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    15
  val max: float -> float -> float
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    16
  val add: float -> float -> float
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    17
  val sub: float -> float -> float
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    18
  val neg: float -> float
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    19
  val mult: float -> float -> float
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    20
  val positive_part: float -> float
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    21
  val negative_part: float -> float
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    22
end;
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    23
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    24
structure Float : FLOAT =
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    25
struct
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    26
24630
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    27
type float = int * int;
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    28
23297
06f108974fa1 simplified type integer;
wenzelm
parents: 23261
diff changeset
    29
val zero: float = (0, 0);
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    30
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    31
fun add (a1, b1) (a2, b2) =
24630
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    32
  if b1 < b2 then
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    33
    (a1 + a2 * Integer.square (b2 - b1), b1)
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    34
  else
24630
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    35
    (a1 * Integer.square (b1 - b2) + a2, b2);
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    36
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    37
fun sub (a1, b1) (a2, b2) =
24630
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    38
  if b1 < b2 then
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    39
    (a1 - a2 * Integer.square (b2 - b1), b1)
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    40
  else
24630
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    41
    (a1 * Integer.square (b1 - b2) - a2, b2);
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    42
24630
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    43
fun neg (a, b) = (~ a, b);
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    44
24630
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    45
fun mult (a1, b1) (a2, b2) = (a1 * a2, b1 + b2);
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    46
23520
483fe92f00c1 tuned arithmetic modules
haftmann
parents: 23297
diff changeset
    47
fun sign (a, b) = Integer.sign a;
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    48
23520
483fe92f00c1 tuned arithmetic modules
haftmann
parents: 23297
diff changeset
    49
fun ord (r, s) = sign (sub r s);
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    50
23520
483fe92f00c1 tuned arithmetic modules
haftmann
parents: 23297
diff changeset
    51
fun eq (r, s) = ord (r, s) = EQUAL;
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    52
23520
483fe92f00c1 tuned arithmetic modules
haftmann
parents: 23297
diff changeset
    53
fun min r s = case ord (r, s) of LESS => r | _ => s;
483fe92f00c1 tuned arithmetic modules
haftmann
parents: 23297
diff changeset
    54
fun max r s = case ord (r, s) of LESS => s | _ => r;
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    55
24630
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    56
fun positive_part (a, b) = (Int.max (0, a), b);
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    57
fun negative_part (a, b) = (Int.min (0, a), b);
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    58
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    59
end;