(* LargeInt -- interface to the GNU Multiple-Precision Library GMP *)exception Domainprim_type int;type largeint = int;(* Interfacing to the C functions that call the GNU GMP library: *)local (* 1. Load the C dynamic library libmgmp.so, and get a handle to it. Assume libmgmp.so is in a directory which is in the LD_LIBRARY_PATH, or that it is in a system library directory and that ldconfig has been run: *) open Dynlib val dlh = dlopen { lib = "libmgmp.so", flag = RTLD_LAZY, global = false }in (* 2. Define SML functions using this handle. Type ascriptions are necessary for SML type safety: *)val largeint_make : unit -> largeint = app1 (dlsym dlh "largeint_make")val largeint_make_si : Int.int -> largeint = app1 (dlsym dlh "largeint_make_si")val largeint_clear : largeint -> unit = app1 (dlsym dlh "largeint_clear")val largeint_set : largeint -> largeint -> unit = app2 (dlsym dlh "largeint_set")val largeint_set_si : largeint -> Int.int -> unit = app2 (dlsym dlh "largeint_set_si")val largeint_to_si : largeint -> Int.int = app1 (dlsym dlh "largeint_to_si")val largeint_neg : largeint -> largeint -> unit = app2 (dlsym dlh "largeint_neg")val largeint_add : largeint -> largeint -> largeint -> unit = app3 (dlsym dlh "largeint_add")val largeint_sub : largeint -> largeint -> largeint -> unit = app3 (dlsym dlh "largeint_sub")val largeint_mul : largeint -> largeint -> largeint -> unit = app3 (dlsym dlh "largeint_mul")val largeint_tdiv : largeint -> largeint -> largeint -> unit = app3 (dlsym dlh "largeint_tdiv")val largeint_tmod : largeint -> largeint -> largeint -> unit = app3 (dlsym dlh "largeint_tmod")val largeint_fdiv : largeint -> largeint -> largeint -> unit = app3 (dlsym dlh "largeint_fdiv")val largeint_fmod : largeint -> largeint -> largeint -> unit = app3 (dlsym dlh "largeint_fmod")val largeint_fdivmod : largeint -> largeint -> largeint -> largeint -> unit = app4 (dlsym dlh "largeint_fdivmod")val largeint_tdivmod : largeint -> largeint -> largeint -> largeint -> unit = app4 (dlsym dlh "largeint_tdivmod")val largeint_cmp : largeint -> largeint -> Int.int = app2 (dlsym dlh "largeint_cmp")val largeint_cmp_si : largeint -> Int.int -> Int.int = app2 (dlsym dlh "largeint_cmp_si")val largeint_sizeinbase : largeint -> Int.int -> Int.int = app2 (dlsym dlh "largeint_sizeinbase")val largeint_get_str : largeint -> Int.int -> string = app2 (dlsym dlh "largeint_get_str")val largeint_set_str : largeint -> string -> Int.int -> unit = app3 (dlsym dlh "largeint_set_str")val largeint_pow_ui : largeint -> largeint -> Int.int -> unit = app3 (dlsym dlh "largeint_pow_ui")endval onepos = largeint_make_si 1and zero = largeint_make_si 0and oneneg = largeint_make_si ~1;val precision = NONEval minInt = NONEval maxInt = NONEfun fromInt 0 = zero | fromInt 1 = onepos | fromInt ~1 = oneneg | fromInt si = largeint_make_si si;fun toInt li = case (Int.minInt, Int.maxInt) of (SOME defaultMinint, SOME defaultMaxint) => if largeint_cmp_si li defaultMinint <> ~1 andalso largeint_cmp_si li defaultMaxint <> 1 then largeint_to_si li else raise Overflow | _ => raise Fail "LargeInt.from: internal error";fun fromLarge x = xfun toLarge x = xfun sign li = largeint_cmp_si li 0; fun sameSign(li1, li2) = sign li1 = sign li2;fun compare(li1, li2) = case largeint_cmp li1 li2 of ~1 => LESS | 0 => EQUAL | 1 => GREATER | _ => raise Fail "LargeInt.compare: internal error";fun ~ li = let val res = largeint_make () in largeint_neg res li; res end;fun abs li = if sign li = ~1 then ~ li else li;fun li1 div li2 = if sign li2 = 0 then raise Div else let val res = largeint_make () in largeint_fdiv res li1 li2; res endfun li1 mod li2 = if sign li2 = 0 then raise Div else let val res = largeint_make () in largeint_fmod res li1 li2; res end;fun quot(li1, li2) = if sign li2 = 0 then raise Div else let val res = largeint_make () in largeint_tdiv res li1 li2; res endfun rem(li1, li2) = if sign li2 = 0 then raise Div else let val res = largeint_make () in largeint_tmod res li1 li2; res endfun divMod(li1, li2) = if sign li2 = 0 then raise Div else let val divres = largeint_make () and modres = largeint_make () in largeint_fdivmod divres modres li1 li2; (divres, modres) end;fun quotRem(li1, li2) = if sign li2 = 0 then raise Div else let val quotres = largeint_make () and remres = largeint_make () in largeint_tdivmod quotres remres li1 li2; (quotres, remres) end;fun log2 li = if Int.<=(sign li, 0) then raise Domain else largeint_sizeinbase li 2;fun pow(li, exp) = if Int.<(exp, 0) then if sign li = 0 then raise Div else if largeint_cmp li onepos = 0 then onepos else if largeint_cmp li oneneg = 0 then oneneg else zero else if exp = 0 then onepos else let val res = largeint_make () in largeint_pow_ui res li exp; res end;fun fmt radix li = let open StringCvt in case radix of BIN => largeint_get_str li 2 | OCT => largeint_get_str li 8 | DEC => largeint_get_str li 10 | HEX => largeint_get_str li 16 end;fun toString li = largeint_get_str li 10;local open StringCvt fun skipWSget getc source = getc (skipWS getc source) prim_val sub_ : string -> Int.int -> char = 2 "get_nth_char"; prim_val mkstring_ : Int.int -> string = 1 "create_string"; prim_val update_ : string -> Int.int -> char -> unit = 3 "set_nth_char";in fun scan radix getc source = let open StringCvt; val (isDigit, factor) = case radix of BIN => (fn c => (#"0" <= c andalso c <= #"1"), 2) | OCT => (fn c => (#"0" <= c andalso c <= #"7"), 8) | DEC => (Char.isDigit, 10) | HEX => (Char.isHexDigit, 16) fun revimplode cs = let val n = List.length cs val newstr = if n > String.maxSize then raise Size else mkstring_ n fun init [] i = () | init (c::cr) i = (update_ newstr i c; init cr (i-1)) in (init cs (n-1); newstr) end; fun makelarge digits src = let val str = revimplode digits val res = largeint_make () in (largeint_set_str res str factor; SOME (res, src)) handle Fail _ => NONE end fun dig1 digits NONE = NONE | dig1 digits (SOME (c, rest)) = let fun digr digits src = case getc src of NONE => makelarge digits src | SOME (c, rest) => if isDigit c then digr (c :: digits) rest else makelarge digits src in if isDigit c then digr (c :: digits) rest else NONE end fun sign NONE = NONE | sign (SOME (#"~", rest)) = dig1 [#"-"] (getc rest) | sign (SOME (#"-", rest)) = dig1 [#"-"] (getc rest) | sign (SOME (#"+", rest)) = dig1 [] (getc rest) | sign inp = dig1 [] inp in sign (skipWSget getc source) end; val fromString = scanString (scan DEC)endval op < = fn (li1, li2) => (largeint_cmp li1 li2) < 0;val op <= = fn (li1, li2) => (largeint_cmp li1 li2) <= 0;val op > = fn (li1, li2) => (largeint_cmp li1 li2) > 0;val op >= = fn (li1, li2) => (largeint_cmp li1 li2) >= 0;fun eq(li1, li2) = (largeint_cmp li1 li2) = 0;fun ne(li1, li2) = (largeint_cmp li1 li2) <> 0;fun min(li1, li2) = if li1 < li2 then li1 else li2;fun max(li1, li2) = if li1 > li2 then li1 else li2;fun op+ (li1, li2) = let val res = largeint_make () in largeint_add res li1 li2; res end;fun op - (li1, li2) = let val res = largeint_make () in largeint_sub res li1 li2; res end;fun op * (li1, li2) = let val res = largeint_make () in largeint_mul res li1 li2; res end;
(* LargeInt -- interface to the GNU Multiple-Precision Library GMP *)
exception Domain
prim_type int;
type largeint = int;
(* Interfacing to the C functions that call the GNU GMP library: *)
local
(* 1. Load the C dynamic library libmgmp.so, and get a handle to it.
Assume libmgmp.so is in a directory which is in the LD_LIBRARY_PATH,
or that it is in a system library directory and that ldconfig has
been run: *)
open Dynlib
val dlh = dlopen { lib = "libmgmp.so",
flag = RTLD_LAZY,
global = false }
in
(* 2. Define SML functions using this handle. Type ascriptions
are necessary for SML type safety: *)
val largeint_make : unit -> largeint
= app1 (dlsym dlh "largeint_make")
val largeint_make_si : Int.int -> largeint
= app1 (dlsym dlh "largeint_make_si")
val largeint_clear : largeint -> unit
= app1 (dlsym dlh "largeint_clear")
val largeint_set : largeint -> largeint -> unit
= app2 (dlsym dlh "largeint_set")
val largeint_set_si : largeint -> Int.int -> unit
= app2 (dlsym dlh "largeint_set_si")
val largeint_to_si : largeint -> Int.int
= app1 (dlsym dlh "largeint_to_si")
val largeint_neg : largeint -> largeint -> unit
= app2 (dlsym dlh "largeint_neg")
val largeint_add : largeint -> largeint -> largeint -> unit
= app3 (dlsym dlh "largeint_add")
val largeint_sub : largeint -> largeint -> largeint -> unit
= app3 (dlsym dlh "largeint_sub")
val largeint_mul : largeint -> largeint -> largeint -> unit
= app3 (dlsym dlh "largeint_mul")
val largeint_tdiv : largeint -> largeint -> largeint -> unit
= app3 (dlsym dlh "largeint_tdiv")
val largeint_tmod : largeint -> largeint -> largeint -> unit
= app3 (dlsym dlh "largeint_tmod")
val largeint_fdiv : largeint -> largeint -> largeint -> unit
= app3 (dlsym dlh "largeint_fdiv")
val largeint_fmod : largeint -> largeint -> largeint -> unit
= app3 (dlsym dlh "largeint_fmod")
val largeint_fdivmod : largeint -> largeint -> largeint -> largeint -> unit
= app4 (dlsym dlh "largeint_fdivmod")
val largeint_tdivmod : largeint -> largeint -> largeint -> largeint -> unit
= app4 (dlsym dlh "largeint_tdivmod")
val largeint_cmp : largeint -> largeint -> Int.int
= app2 (dlsym dlh "largeint_cmp")
val largeint_cmp_si : largeint -> Int.int -> Int.int
= app2 (dlsym dlh "largeint_cmp_si")
val largeint_sizeinbase : largeint -> Int.int -> Int.int
= app2 (dlsym dlh "largeint_sizeinbase")
val largeint_get_str : largeint -> Int.int -> string
= app2 (dlsym dlh "largeint_get_str")
val largeint_set_str : largeint -> string -> Int.int -> unit
= app3 (dlsym dlh "largeint_set_str")
val largeint_pow_ui : largeint -> largeint -> Int.int -> unit
= app3 (dlsym dlh "largeint_pow_ui")
end
val onepos = largeint_make_si 1
and zero = largeint_make_si 0
and oneneg = largeint_make_si ~1;
val precision = NONE
val minInt = NONE
val maxInt = NONE
fun fromInt 0 = zero
| fromInt 1 = onepos
| fromInt ~1 = oneneg
| fromInt si = largeint_make_si si;
fun toInt li =
case (Int.minInt, Int.maxInt) of
(SOME defaultMinint, SOME defaultMaxint) =>
if largeint_cmp_si li defaultMinint <> ~1
andalso largeint_cmp_si li defaultMaxint <> 1
then
largeint_to_si li
else
raise Overflow
| _ => raise Fail "LargeInt.from: internal error";
fun fromLarge x = x
fun toLarge x = x
fun sign li = largeint_cmp_si li 0;
fun sameSign(li1, li2) = sign li1 = sign li2;
fun compare(li1, li2) =
case largeint_cmp li1 li2 of
~1 => LESS
| 0 => EQUAL
| 1 => GREATER
| _ => raise Fail "LargeInt.compare: internal error";
fun ~ li =
let val res = largeint_make ()
in largeint_neg res li; res end;
fun abs li =
if sign li = ~1 then ~ li else li;
fun li1 div li2 =
if sign li2 = 0 then raise Div
else
let val res = largeint_make ()
in largeint_fdiv res li1 li2; res end
fun li1 mod li2 =
if sign li2 = 0 then raise Div
else
let val res = largeint_make ()
in
largeint_fmod res li1 li2;
res
end;
fun quot(li1, li2) =
if sign li2 = 0 then raise Div
else
let val res = largeint_make ()
in largeint_tdiv res li1 li2; res end
fun rem(li1, li2) =
if sign li2 = 0 then raise Div
else
let val res = largeint_make ()
in largeint_tmod res li1 li2; res end
fun divMod(li1, li2) =
if sign li2 = 0 then raise Div
else
let val divres = largeint_make ()
and modres = largeint_make ()
in
largeint_fdivmod divres modres li1 li2;
(divres, modres)
end;
fun quotRem(li1, li2) =
if sign li2 = 0 then raise Div
else
let val quotres = largeint_make ()
and remres = largeint_make ()
in largeint_tdivmod quotres remres li1 li2; (quotres, remres) end;
fun log2 li =
if Int.<=(sign li, 0) then raise Domain
else largeint_sizeinbase li 2;
fun pow(li, exp) =
if Int.<(exp, 0) then
if sign li = 0 then raise Div
else if largeint_cmp li onepos = 0 then onepos
else if largeint_cmp li oneneg = 0 then oneneg
else zero
else if exp = 0 then onepos
else
let val res = largeint_make ()
in largeint_pow_ui res li exp; res end;
fun fmt radix li =
let open StringCvt
in case radix of
BIN => largeint_get_str li 2
| OCT => largeint_get_str li 8
| DEC => largeint_get_str li 10
| HEX => largeint_get_str li 16
end;
fun toString li = largeint_get_str li 10;
local
open StringCvt
fun skipWSget getc source = getc (skipWS getc source)
prim_val sub_ : string -> Int.int -> char = 2 "get_nth_char";
prim_val mkstring_ : Int.int -> string = 1 "create_string";
prim_val update_ : string -> Int.int -> char -> unit
= 3 "set_nth_char";
in
fun scan radix getc source =
let open StringCvt;
val (isDigit, factor) =
case radix of
BIN => (fn c => (#"0" <= c andalso c <= #"1"), 2)
| OCT => (fn c => (#"0" <= c andalso c <= #"7"), 8)
| DEC => (Char.isDigit, 10)
| HEX => (Char.isHexDigit, 16)
fun revimplode cs =
let val n = List.length cs
val newstr = if n > String.maxSize then raise Size
else mkstring_ n
fun init [] i = ()
| init (c::cr) i = (update_ newstr i c; init cr (i-1))
in (init cs (n-1); newstr) end;
fun makelarge digits src =
let val str = revimplode digits
val res = largeint_make ()
in
(largeint_set_str res str factor; SOME (res, src))
handle Fail _ => NONE
end
fun dig1 digits NONE = NONE
| dig1 digits (SOME (c, rest)) =
let fun digr digits src =
case getc src of
NONE => makelarge digits src
| SOME (c, rest) =>
if isDigit c then digr (c :: digits) rest
else makelarge digits src
in
if isDigit c then digr (c :: digits) rest
else NONE
end
fun sign NONE = NONE
| sign (SOME (#"~", rest)) = dig1 [#"-"] (getc rest)
| sign (SOME (#"-", rest)) = dig1 [#"-"] (getc rest)
| sign (SOME (#"+", rest)) = dig1 [] (getc rest)
| sign inp = dig1 [] inp
in sign (skipWSget getc source) end;
val fromString = scanString (scan DEC)
end
val op < = fn (li1, li2) => (largeint_cmp li1 li2) < 0;
val op <= = fn (li1, li2) => (largeint_cmp li1 li2) <= 0;
val op > = fn (li1, li2) => (largeint_cmp li1 li2) > 0;
val op >= = fn (li1, li2) => (largeint_cmp li1 li2) >= 0;
fun eq(li1, li2) = (largeint_cmp li1 li2) = 0;
fun ne(li1, li2) = (largeint_cmp li1 li2) <> 0;
fun min(li1, li2) = if li1 < li2 then li1 else li2;
fun max(li1, li2) = if li1 > li2 then li1 else li2;
fun op+ (li1, li2) =
let val res = largeint_make ()
in largeint_add res li1 li2; res end;
fun op - (li1, li2) =
let val res = largeint_make ()
in largeint_sub res li1 li2; res end;
fun op * (li1, li2) =
let val res = largeint_make ()
in largeint_mul res li1 li2; res end;