File: gmp.ml

package info (click to toggle)
mlgmp 20021123-19
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 484 kB
  • ctags: 982
  • sloc: ansic: 3,257; ml: 2,686; makefile: 167
file content (580 lines) | stat: -rw-r--r-- 21,534 bytes parent folder | download | duplicates (3)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
(*
 * ML GMP - Interface between Objective Caml and GNU MP
 * Copyright (C) 2001 David MONNIAUX
 * 
 * This software is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Library General Public
 * License version 2 published by the Free Software Foundation,
 * or any more recent version published by the Free Software
 * Foundation, at your choice.
 * 
 * This software is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 * 
 * See the GNU Library General Public License version 2 for more details
 * (enclosed in the file LGPL).
 *
 * As a special exception to the GNU Library General Public License, you
 * may link, statically or dynamically, a "work that uses the Library"
 * with a publicly distributed version of the Library to produce an
 * executable file containing portions of the Library, and distribute
 * that executable file under terms of your choice, without any of the
 * additional requirements listed in clause 6 of the GNU Library General
 * Public License.  By "a publicly distributed version of the Library",
 * we mean either the unmodified Library as distributed by INRIA, or a
 * modified version of the Library that is distributed under the
 * conditions defined in clause 3 of the GNU Library General Public
 * License.  This exception does not however invalidate any other reasons
 * why the executable file might be covered by the GNU Library General
 * Public License.
 *)

type rounding_mode =
    GMP_RNDN
  | GMP_RNDZ
  | GMP_RNDU
  | GMP_RNDD

exception Unimplemented of string;;
let _ = Callback.register_exception "Gmp.Division_by_zero" Division_by_zero;;
let _ = Callback.register_exception "Gmp.Unimplemented" (Unimplemented "foo");;

module RNG = struct
  type randstate_t;;
  type randalg_t = GMP_RAND_ALG_LC of int;;

  external randinit_lc: int->randstate_t = "_mlgmp_randinit_lc";;

  let randinit = function
    GMP_RAND_ALG_LC(n) ->
      (if n>128 || n<1
      then raise (Invalid_argument "Gmp.Random.randinit"));
      randinit_lc n

  let default = randinit (GMP_RAND_ALG_LC 128)
end;;

module Z2 = struct
  external z_initialize : unit->unit = "_mlgmp_z_initialize";;
  z_initialize ();;

  type t;;
  external from_int: dest: t->int->unit = "_mlgmp_z2_from_int";;
  external from_string_base: dest: t->base: int->string->unit
      ="_mlgmp_z2_from_string_base";;
  external from_float: dest: t->float->unit = "_mlgmp_z2_from_float";;

  external create: unit->t = "_mlgmp_z_create";;
  external copy: dest: t-> from: t-> unit = "_mlgmp_z2_copy";;
  external add: dest: t-> t->t->unit = "_mlgmp_z2_add";;
  external sub: dest: t-> t->t->unit = "_mlgmp_z2_sub";;
  external mul: dest: t-> t->t->unit = "_mlgmp_z2_mul";;

  external tdiv_q: dest: t-> t->t->unit = "_mlgmp_z2_tdiv_q";;
  external tdiv_r: dest: t-> t->t->unit = "_mlgmp_z2_tdiv_r";;
  external cdiv_q: dest: t-> t->t->unit = "_mlgmp_z2_cdiv_q";;
  external cdiv_r: dest: t-> t->t->unit = "_mlgmp_z2_cdiv_r";;
  external fdiv_q: dest: t-> t->t->unit = "_mlgmp_z2_fdiv_q";;
  external fdiv_r: dest: t-> t->t->unit = "_mlgmp_z2_fdiv_r";;
  external divexact: dest: t-> t->t->unit = "_mlgmp_z2_divexact";;

  external neg: dest: t->t->unit = "_mlgmp_z2_neg";;
  external abs: dest: t->t->unit = "_mlgmp_z2_abs";;
end;;

module Z = struct
  type t = Z2.t;;
  external copy: t->t = "_mlgmp_z_copy";;
  external of_int: int->t = "_mlgmp_z_from_int";;
  external from_int: int->t = "_mlgmp_z_from_int";;
  external from_string_base: base: int->string->t="_mlgmp_z_from_string_base";;
  external of_float: float->t = "_mlgmp_z_from_float";;
  external from_float: float->t = "_mlgmp_z_from_float";;

  external to_string_base: base: int->t->string = "_mlgmp_z_to_string_base";;
  external to_int: t->int = "_mlgmp_z_to_int";;
  external to_float: t->float = "_mlgmp_z_to_float";;

  external int_from: t->int = "_mlgmp_z_to_int";;
  external float_from: t->float = "_mlgmp_z_to_float";;

  external add: t->t->t = "_mlgmp_z_add";;
  external sub: t->t->t = "_mlgmp_z_sub";;
  external mul: t->t->t = "_mlgmp_z_mul";;

  external add_ui: t->int->t = "_mlgmp_z_add_ui";;
  external sub_ui: t->int->t = "_mlgmp_z_sub_ui";;
  external mul_ui: t->int->t = "_mlgmp_z_mul_ui";;

  external neg: t->t = "_mlgmp_z_neg";;
  external abs: t->t = "_mlgmp_z_abs";;

  external tdiv_qr: t->t->t*t = "_mlgmp_z_tdiv_qr";;
  external tdiv_q: t->t->t = "_mlgmp_z_tdiv_q";;
  external tdiv_r: t->t->t = "_mlgmp_z_tdiv_r";;

  external cdiv_qr: t->t->t*t = "_mlgmp_z_cdiv_qr";;
  external cdiv_q: t->t->t = "_mlgmp_z_cdiv_q";;
  external cdiv_r: t->t->t = "_mlgmp_z_cdiv_r";;

  external fdiv_qr: t->t->t*t = "_mlgmp_z_fdiv_qr";;
  external fdiv_q: t->t->t = "_mlgmp_z_fdiv_q";;
  external fdiv_r: t->t->t = "_mlgmp_z_fdiv_r";;

  external dmod: t->t->t = "_mlgmp_z_mod";;
  external dmod_ui: t->int->t = "_mlgmp_z_mod_ui";;

  external euclidean_division: t->t->t*t = "_mlgmp_z_fdiv_qr";;
  external modulo: t->t->t = "_mlgmp_z_mod";;

  external tdiv_qr_ui: t->int->t*t = "_mlgmp_z_tdiv_qr_ui";;
  external tdiv_q_ui: t->int->t = "_mlgmp_z_tdiv_q_ui";;
  external tdiv_r_ui: t->int->t = "_mlgmp_z_tdiv_r_ui";;
  external tdiv_ui: t->int->int = "_mlgmp_z_tdiv_ui";;

  external cdiv_qr_ui: t->int->t*t = "_mlgmp_z_cdiv_qr_ui";;
  external cdiv_q_ui: t->int->t = "_mlgmp_z_cdiv_q_ui";;
  external cdiv_r_ui: t->int->t = "_mlgmp_z_cdiv_r_ui";;
  external cdiv_ui: t->int->int = "_mlgmp_z_cdiv_ui";;

  external fdiv_qr_ui: t->int->t*t = "_mlgmp_z_fdiv_qr_ui";;
  external fdiv_q_ui: t->int->t = "_mlgmp_z_fdiv_q_ui";;
  external fdiv_r_ui: t->int->t = "_mlgmp_z_fdiv_r_ui";;
  external fdiv_ui: t->int->int = "_mlgmp_z_fdiv_ui";;

  external divexact: t->t->t = "_mlgmp_z_divexact";;

  external mul_2exp: t->int->t = "_mlgmp_z_mul_2exp";;
  external mul2exp: t->int->t = "_mlgmp_z_mul_2exp";;
  external tdiv_q_2exp: t->int->t = "_mlgmp_z_tdiv_q_2exp";;
  external tdiv_r_2exp: t->int->t = "_mlgmp_z_tdiv_r_2exp";;
  external fdiv_q_2exp: t->int->t = "_mlgmp_z_fdiv_q_2exp";;
  external fdiv_r_2exp: t->int->t = "_mlgmp_z_fdiv_r_2exp";;
  external cdiv_q_2exp: t->int->t = "_mlgmp_z_cdiv_q_2exp";;
  external cdiv_r_2exp: t->int->t = "_mlgmp_z_cdiv_r_2exp";;

  external powm: t->t->t->t = "_mlgmp_z_powm";;
  external powm_ui: t->int->t->t = "_mlgmp_z_powm_ui";;
  external pow_ui: t->int->t = "_mlgmp_z_pow_ui";;
  external ui_pow_ui: int->int->t = "_mlgmp_z_ui_pow_ui";;
  external pow_ui_ui: int->int->t = "_mlgmp_z_ui_pow_ui";;

  external sqrt: t->t = "_mlgmp_z_sqrt"
  external sqrtrem: t->t*t = "_mlgmp_z_sqrtrem"
  external root: t->int->t = "_mlgmp_z_root"
  external perfect_power_p: t->bool = "_mlgmp_z_perfect_power_p"
  external perfect_square_p: t->bool = "_mlgmp_z_perfect_square_p"
  external is_perfect_power: t->bool = "_mlgmp_z_perfect_power_p"
  external is_perfect_square: t->bool = "_mlgmp_z_perfect_square_p"

  external probab_prime_p: t->int->bool = "_mlgmp_z_probab_prime_p"
  external is_probab_prime: t->int->bool = "_mlgmp_z_probab_prime_p"
  external nextprime: t->t = "_mlgmp_z_nextprime"

  external gcd: t->t->t = "_mlgmp_z_gcd"
  external gcd_ui: t->t->t = "_mlgmp_z_gcd_ui"
  external lcm: t->t->t = "_mlgmp_z_lcm"
  external gcdext: t->t->t*t*t = "_mlgmp_z_gcdext"
  external inverse: t->t->t option="_mlgmp_z_invert"
  external legendre: t->t->int="_mlgmp_z_legendre"
  external jacobi: t->t->int="_mlgmp_z_jacobi"
  external kronecker_si: t->int->int="_mlgmp_z_kronecker_si"
  external si_kronecker: int->t->int="_mlgmp_z_si_kronecker"
  external remove: t->t->t*int="_mlgmp_z_remove"

  external fac_ui: int->t="_mlgmp_z_fac_ui"
  external fib_ui: int->t="_mlgmp_z_fib_ui"
  external bin_ui: n: t-> k: int->t="_mlgmp_z_bin_ui"
  external bin_uiui: n: int-> k: int->t="_mlgmp_z_bin_uiui"

  external cmp: t->t->int = "_mlgmp_z_compare";;
  external cmp_si: t->int->int = "_mlgmp_z_compare_si";;
  external compare: t->t->int = "_mlgmp_z_compare";;
  external compare_si: t->int->int = "_mlgmp_z_compare_si";;
  external compare_int: t->int->int = "_mlgmp_z_compare_si";;
  external sgn: t->int = "_mlgmp_z_sgn";;

  external band: t->t->t = "_mlgmp_z_and";;
  external bior: t->t->t = "_mlgmp_z_ior";;
  external bxor: t->t->t = "_mlgmp_z_xor";;
  external bcom: t->t = "_mlgmp_z_com";;
  external popcount: t->int = "_mlgmp_z_popcount";;
  external hamdist: t->t->int = "_mlgmp_z_hamdist";;
  external scan0: t->int->int = "_mlgmp_z_scan0";;
  external scan1: t->int->int = "_mlgmp_z_scan1";;

(* missing set/clear bit *)

  external urandomb: state: RNG.randstate_t->nbits: int->t =
    "_mlgmp_z_urandomb";;
  external urandomm: state: RNG.randstate_t->n: t->t =
    "_mlgmp_z_urandomm";;
  external rrandomb: state: RNG.randstate_t->nbits: int->t =
    "_mlgmp_z_rrandomb";;

  let zero = from_int 0 and one = from_int 1;;
  let succ x = add one x
  let pred x = sub x one
  let min x y = if (compare x y) <= 0 then x else y
  let max x y = if (compare x y) >= 0 then x else y

  let is_prime ?(prec = 10) x = is_probab_prime x prec
  let equal x y = (compare x y) = 0
  let equal_int x y = (compare_int x y) = 0
  let is_zero x = (sgn x) = 0

  let to_string = to_string_base ~base: 10
  let from_string = from_string_base ~base: 10
  let string_from = to_string

  let output chan n =
    output_string chan (to_string n);;
  let sprintf () = to_string;;
  let print formatter x = Format.pp_print_string formatter (to_string x)

  module Infixes=
  struct
    external ( +! ) : t -> t -> t = "_mlgmp_z_add"
    external ( -! ) : t -> t -> t = "_mlgmp_z_sub"
    external ( *! ) : t -> t -> t = "_mlgmp_z_mul"
    external ( /! ) : t -> t -> t = "_mlgmp_z_fdiv_q" 
    external ( %! ) : t -> t -> t = "_mlgmp_z_fdiv_r"
    let ( <!  ) x y = (cmp x y)<0
    let ( <=! ) x y = (cmp x y)<=0
    let ( =!  ) x y = (cmp x y)=0
    let ( >=! ) x y = (cmp x y)>=0
    let ( >!  ) x y = (cmp x y)>0
    let ( <>! ) x y = (cmp x y)<>0
  end;;
end;;

module Q = struct
  external q_initialize : unit->unit = "_mlgmp_q_initialize";;
  q_initialize ();;

  type t;;
  external create: unit->t = "_mlgmp_q_create";;

  external from_z : Z.t->t = "_mlgmp_q_from_z";;
  external from_si : int->int->t = "_mlgmp_q_from_si";;
  external from_ints : int->int->t = "_mlgmp_q_from_si";;
  external from_float : float->t = "_mlgmp_q_from_float";;

  let from_int x = from_ints x 1

  external float_from : t->float = "_mlgmp_q_to_float";;
  external to_float : t->float = "_mlgmp_q_to_float";;

  external add : t->t->t = "_mlgmp_q_add";;
  external sub : t->t->t = "_mlgmp_q_sub";;
  external mul : t->t->t = "_mlgmp_q_mul";;
  external div : t->t->t = "_mlgmp_q_div";;

  external neg : t->t = "_mlgmp_q_neg";;
  external inv : t->t = "_mlgmp_q_inv";;

  external get_num : t->Z.t = "_mlgmp_q_get_num";;
  external get_den : t->Z.t = "_mlgmp_q_get_den";;

  external cmp : t->t->int = "_mlgmp_q_cmp";;
  external compare : t->t->int = "_mlgmp_q_cmp";;
  external cmp_ui : t->int->int->int = "_mlgmp_q_cmp_ui";;
  external sgn : t->int = "_mlgmp_q_sgn";;

  let zero = create ();;
  let is_zero x = (sgn x) = 0;;

  let from_zs num den = div (from_z num) (from_z den)
  let equal x y = (cmp x y) = 0;;
  let output chan x = Printf.fprintf chan "%a/%a"
      Z.output (get_num x) Z.output (get_den x)
  let to_string x = Printf.sprintf "%a/%a"
      Z.sprintf (get_num x) Z.sprintf (get_den x)
  let sprintf () = to_string

  module Infixes=
  struct
    external ( +/ ) : t -> t -> t = "_mlgmp_q_add"
    external ( -/ ) : t -> t -> t = "_mlgmp_q_sub"
    external ( */ ) : t -> t -> t = "_mlgmp_q_mul"
    external ( // ) : t -> t -> t = "_mlgmp_q_div" 
    let ( </  ) x y = (cmp x y)<0
    let ( <=/ ) x y = (cmp x y)<=0
    let ( =/  ) x y = (cmp x y)=0
    let ( >=/ ) x y = (cmp x y)>=0
    let ( >/  ) x y = (cmp x y)>0
    let ( <>/ ) x y = (cmp x y)<>0
  end;;
end;;

module F = struct
  external f_initialize : unit->unit = "_mlgmp_f_initialize";;
  f_initialize ();;

  type t;;
  external create: unit->t = "_mlgmp_f_create";;

  let default_prec = ref 120

  external from_z_prec : prec: int->Z.t->t = "_mlgmp_f_from_z";;
  external from_q_prec : prec: int->Z.t->t = "_mlgmp_f_from_q";;
  external from_si_prec : prec: int->int->t = "_mlgmp_f_from_si";;
  external from_float_prec : prec: int->float->t = "_mlgmp_f_from_float";;
  external from_string_prec_base : prec: int->base: int->string->t =
    "_mlgmp_f_from_string";;

  external float_from : t->float = "_mlgmp_f_to_float";;
  external to_float : t->float = "_mlgmp_f_to_float";;

  external to_string_exp_base_digits : base: int-> digits: int->t->string*int =
    "_mlgmp_f_to_string_exp_base_digits"

  external add_prec : prec: int->t->t->t = "_mlgmp_f_add";;
  external sub_prec : prec: int->t->t->t = "_mlgmp_f_sub";;
  external mul_prec : prec: int->t->t->t = "_mlgmp_f_mul";;
  external div_prec : prec: int->t->t->t = "_mlgmp_f_div";;

  external add_prec_ui : prec: int->t->int->t = "_mlgmp_f_add_ui";;
  external sub_prec_ui : prec: int->t->int->t = "_mlgmp_f_sub_ui";;
  external mul_prec_ui : prec: int->t->int->t = "_mlgmp_f_mul_ui";;
  external div_prec_ui : prec: int->t->int->t = "_mlgmp_f_div_ui";;

  external neg_prec : prec: int->t->t = "_mlgmp_f_neg";;
  external abs_prec : prec: int->t->t = "_mlgmp_f_abs";;
  external inv_prec : prec: int->t->t = "_mlgmp_f_div";;
  external reldiff_prec : prec: int->t->t = "_mlgmp_f_reldiff";;

  external floor_prec : prec: int->t->t = "_mlgmp_f_floor";;
  external ceil_prec : prec: int->t->t = "_mlgmp_f_ceil";;
  external trunc_prec : prec: int->t->t = "_mlgmp_f_trunc";;

  let default f x = f ~prec: !default_prec x

  let from_z = default from_z_prec
  let from_q = default from_q_prec
  let from_si = default from_si_prec
  let from_int = from_si
  let from_float = default from_float_prec
  let from_string_base = from_string_prec_base ~prec: !default_prec
  let from_string = from_string_base ~base: 10

  let zero = from_int 0

  let add = default add_prec
  let sub = default sub_prec
  let mul = default mul_prec
  let div = default div_prec
  let reldiff = default reldiff_prec

  let add_ui = default add_prec_ui
  let sub_ui = default sub_prec_ui
  let mul_ui = default mul_prec_ui
  let div_ui = default div_prec_ui

  let neg = default neg_prec
  let abs = default abs_prec
  let inv = default inv_prec
  let floor = default floor_prec
  let ceil = default ceil_prec
  let trunc = default trunc_prec

  external cmp : t->t->int = "_mlgmp_f_cmp";;
  external compare : t->t->int = "_mlgmp_f_cmp";;
  external sgn : t->int = "_mlgmp_f_sgn";;
  external eq : t->t-> prec: int->bool = "_mlgmp_f_eq";;

  external urandomb_prec : prec: int -> state: RNG.randstate_t ->
    nbits: int -> t = "_mlgmp_f_urandomb"
  external random2 : prec: int -> nlimbs: int -> max_exp: int -> t =
    "_mlgmp_f_random2"

  let urandomb ~state: state ~nbits: bits =
    urandomb_prec ~prec: bits ~state: state ~nbits: bits

  let equal x y = eq x y ~prec: 90;;

  let to_string_base_digits ~base: base ~digits: digits x =
    let mantissa, exponent =
      to_string_exp_base_digits ~base: base ~digits: digits (abs x)
    in let sign = sgn x in
       if sign = 0 then "0" else
       ((if sign < 0 then "-" else "")
       ^ (let lm=String.length mantissa
        in if lm > 1
           then let tmp = String.create (succ lm)
                in String.blit mantissa 0 tmp 0 1;
                   String.blit mantissa 1 tmp 2 (pred lm);
                   String.set tmp 1 '.';
                   tmp
           else mantissa)
       ^ (if base <= 10 then "E" else "@")
       ^ (string_of_int (pred exponent)));;

  let to_string = to_string_base_digits ~base: 10 ~digits: 10;;

(* It seems that marshalling for F.t is not accurate. *)
end;;

module FR = struct
  external fr_initialize : unit->unit = "_mlgmp_fr_initialize";;
  fr_initialize ();;

  type t;;
  let default_prec = ref 120

  external create_prec: prec: int->unit->t = "_mlgmp_fr_create";;
  let create = create_prec ~prec: !default_prec

  external from_z_prec : prec: int -> mode: rounding_mode -> 
    Z.t->t = "_mlgmp_fr_from_z";;
  external from_q_prec : prec: int -> mode: rounding_mode -> 
    Z.t->t = "_mlgmp_fr_from_z";;
  external from_si_prec : prec: int -> mode: rounding_mode -> 
    int->t = "_mlgmp_fr_from_si";;
  external from_float_prec : prec: int -> mode: rounding_mode -> 
    float->t = "_mlgmp_fr_from_float";;
  external from_string_prec_base : prec: int-> mode: rounding_mode ->
    base: int->string->t = "_mlgmp_fr_from_string";;

  external to_string_exp_base_digits :
    mode: rounding_mode ->
    base: int-> digits: int->t->string*int =
    "_mlgmp_fr_to_string_exp_base_digits"

  external add_prec : prec: int -> mode: rounding_mode -> 
    t->t->t = "_mlgmp_fr_add";;
  external sub_prec : prec: int -> mode: rounding_mode -> 
    t->t->t = "_mlgmp_fr_sub";;
  external mul_prec : prec: int -> mode: rounding_mode -> 
    t->t->t = "_mlgmp_fr_mul";;
  external div_prec : prec: int -> mode: rounding_mode -> 
    t->t->t = "_mlgmp_fr_div";;

  external add_prec_ui : prec: int -> mode: rounding_mode -> 
    t->int->t = "_mlgmp_fr_add_ui";;
  external sub_prec_ui : prec: int -> mode: rounding_mode -> 
    t->int->t = "_mlgmp_fr_sub_ui";;
  external mul_prec_ui : prec: int -> mode: rounding_mode -> 
    t->int->t = "_mlgmp_fr_mul_ui";;
  external div_prec_ui : prec: int -> mode: rounding_mode -> 
    t->int->t = "_mlgmp_fr_div_ui";;

  external neg_prec : prec: int -> mode: rounding_mode -> t->t
      = "_mlgmp_fr_neg";;
  external abs_prec : prec: int -> mode: rounding_mode -> t->t
      = "_mlgmp_fr_abs";;
  external inv_prec : prec: int -> mode: rounding_mode -> t->t
      = "_mlgmp_fr_div";;
  external reldiff_prec : prec: int -> mode: rounding_mode -> t->t
      = "_mlgmp_fr_reldiff";;

  external float_from : t->float = "_mlgmp_fr_to_float";;
  external to_float_mode : mode: rounding_mode -> t -> float = "_mlgmp_fr_to_float";;

  external to_z_exp : t->Z.t*int = "_mlgmp_fr_to_z_exp";;

  external ceil_prec : prec: int -> t -> t = "_mlgmp_fr_ceil";;
  external floor_prec : prec: int -> t -> t = "_mlgmp_fr_floor";;
  external trunc_prec : prec: int -> t -> t = "_mlgmp_fr_trunc";;

  external cmp : t->t->int = "_mlgmp_fr_cmp";;
  external compare : t->t->int = "_mlgmp_fr_cmp";;
  external sgn : t->int = "_mlgmp_fr_sgn";;
  external eq : t->t-> prec: int->bool = "_mlgmp_fr_eq";;
  external is_nan : t->bool = "_mlgmp_fr_is_nan";;

  external urandomb : prec: int -> state: RNG.randstate_t -> t=
    "_mlgmp_fr_urandomb";;
  external random : prec: int -> t = "_mlgmp_fr_random"
  (* Old MPFR - no longer exists in 20011026
  external srandom : int -> unit = "_mlgmp_fr_srandom"
  *)
  external random2 : prec: int -> nlimbs: int -> max_exp: int -> t =
    "_mlgmp_fr_random2"

  let default f x = f ~prec: !default_prec ~mode: GMP_RNDN x
  let default_rnd f x = f ~prec: !default_prec x

  let from_z = default from_z_prec
  let from_q = default from_q_prec
  let from_si = default from_si_prec
  let from_int = from_si
  let from_float = default from_float_prec
  let from_string_base = from_string_prec_base
      ~prec: !default_prec ~mode: GMP_RNDN
  let from_string = from_string_base ~base: 10
  let to_float = to_float_mode ~mode: GMP_RNDN

  let zero =
    try from_int 0
    with Unimplemented _ -> Obj.magic 0;;

  let add = default add_prec
  let sub = default sub_prec
  let mul = default mul_prec
  let div = default div_prec
  let reldiff = default reldiff_prec

  let add_ui = default add_prec_ui
  let sub_ui = default sub_prec_ui
  let mul_ui = default mul_prec_ui
  let div_ui = default div_prec_ui

  let neg = default neg_prec
  let abs = default abs_prec
  let inv = default inv_prec

  let floor = default_rnd floor_prec
  let ceil = default_rnd ceil_prec
  let trunc = default_rnd trunc_prec

  let equal x y = eq x y ~prec: 90;;

  let to_string_base_digits ~mode: mode
      ~base: base ~digits: digits x =
    let mantissa, exponent =
      to_string_exp_base_digits ~mode: mode ~base: base ~digits: digits (abs x)
       in (if (sgn x) < 0 then "-" else "")
       ^ (if mantissa = "Inf"
          then "Inf"
          else (let lm=String.length mantissa
        in if lm > 1
           then let tmp = String.create (succ lm)
                in String.blit mantissa 0 tmp 0 1;
                   String.blit mantissa 1 tmp 2 (pred lm);
                   String.set tmp 1 '.';
                   tmp
           else mantissa)
       ^ (if base <= 10 then "E" else "@")
       ^ (string_of_int (pred exponent)));;

  let to_string = to_string_base_digits ~mode: GMP_RNDN ~base: 10 ~digits: 10;;

  external is_available : unit -> bool = "_mlgmp_is_mpfr_available";;

 let to_z_rounding division x =
   let sign = sgn x in
   if sign = 0
   then Z.zero
   else
     let unsigned_mantissa, exponent = to_z_exp x in
     let mantissa = if sign<0
                    then Z.neg unsigned_mantissa
                    else unsigned_mantissa in
     if exponent < 0
     then division mantissa (- exponent)
     else Z.mul_2exp mantissa exponent;;

 let to_z_t = to_z_rounding Z.tdiv_q_2exp
 let to_z_c = to_z_rounding Z.cdiv_q_2exp
 let to_z_f = to_z_rounding Z.fdiv_q_2exp

 let to_z = to_z_t
 let z_from = to_z
end;;

external get_gmp_runtime_version: unit->string =
  "_mlgmp_get_runtime_version";;
external get_gmp_compile_version: unit->int*int*int =
  "_mlgmp_get_compile_version";;