265 lines · 8.0 KB · Standard ML
RawDownload
(* 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 1and zero   = largeint_make_si 0and oneneg = largeint_make_si ~1; val precision = NONEval minInt    = NONEval 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 = xfun 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;

Keyboard shortcuts

General

Show keyboard shortcuts
?
Focus the current search
/

Issues and pull requests

Open filters
f

Issues, pull requests and Inbox

Select next item
j↓
Select previous item
k↑
Open selected item
Enter
Dismiss filters or clear selection
Esc

Repository code

Go to file
t