src/Tools/integer.ML
author wenzelm
Tue, 18 Sep 2007 16:08:00 +0200
changeset 24630 351a308ab58d
parent 24584 01e83ffa6c54
permissions -rw-r--r--
simplified type int (eliminated IntInf.int, integer);
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
24584
01e83ffa6c54 fixed title
haftmann
parents: 23520
diff changeset
     1
(*  Title:      Tools/integer.ML
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
     2
    ID:         $Id$
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
     3
    Author:     Florian Haftmann, TU Muenchen
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
     4
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
     5
Unbounded integers.
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
     6
*)
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
     7
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
     8
signature INTEGER =
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
     9
sig
23520
483fe92f00c1 tuned arithmetic modules
haftmann
parents: 23517
diff changeset
    10
  val sign: int -> order
24630
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    11
  val sum: int list -> int
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    12
  val div_mod: int -> int -> int * int
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    13
  val square: int -> int
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    14
  val pow: int -> int -> int (* exponent -> base -> result *)
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    15
  val gcd: int -> int -> int
24630
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    16
  val gcds: int list -> int
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    17
  val lcm: int -> int -> int
24630
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    18
  val lcms: int list -> int
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    19
end;
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    20
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    21
structure Integer : INTEGER =
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    22
struct
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    23
24630
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    24
fun sign x = int_ord (x, 0);
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    25
24630
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    26
fun sum xs = fold (curry op +) xs 0;
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    27
24630
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    28
fun div_mod x y = IntInf.divMod (x, y);
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    29
24630
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    30
fun square x = x * x;
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    31
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    32
fun pow k l =
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    33
  let
23520
483fe92f00c1 tuned arithmetic modules
haftmann
parents: 23517
diff changeset
    34
    fun pw 0 _ = 1
483fe92f00c1 tuned arithmetic modules
haftmann
parents: 23517
diff changeset
    35
      | pw 1 l = l
483fe92f00c1 tuned arithmetic modules
haftmann
parents: 23517
diff changeset
    36
      | pw k l =
483fe92f00c1 tuned arithmetic modules
haftmann
parents: 23517
diff changeset
    37
          let
24630
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    38
            val (k', r) = div_mod k 2;
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    39
            val l' = pw k' (l * l);
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    40
          in if r = 0 then l' else l' * l end;
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    41
  in
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    42
    if k < 0
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    43
    then error "pow: negative exponent"
23520
483fe92f00c1 tuned arithmetic modules
haftmann
parents: 23517
diff changeset
    44
    else pw k l
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    45
  end;
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    46
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    47
fun gcd x y =
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    48
  let
24630
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    49
    fun gxd x y = if y = 0 then x else gxd y (x mod y)
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    50
  in if x < y then gxd y x else gxd x y end;
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    51
24630
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    52
fun gcds xs = fold gcd xs 0;
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    53
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    54
fun lcm x y = (x * y) div (gcd x y);
351a308ab58d simplified type int (eliminated IntInf.int, integer);
wenzelm
parents: 24584
diff changeset
    55
fun lcms xs = fold lcm xs 1;
23251
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    56
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    57
end;
471b576aad25 moved generic algebra modules
haftmann
parents:
diff changeset
    58