1. camlspotter
  2. compiler-libs-hack

Source

compiler-libs-hack / ocaml / otherlibs / num / num.ml

  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
(***********************************************************************)
(*                                                                     *)
(*                                OCaml                                *)
(*                                                                     *)
(*    Valerie Menissier-Morain, projet Cristal, INRIA Rocquencourt     *)
(*                                                                     *)
(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
(*  en Automatique.  All rights reserved.  This file is distributed    *)
(*  under the terms of the GNU Library General Public License, with    *)
(*  the special exception on linking described in file ../../LICENSE.  *)
(*                                                                     *)
(***********************************************************************)

(* $Id$ *)

open Int_misc
open Nat
open Big_int
open Arith_flags
open Ratio

type num = Int of int | Big_int of big_int | Ratio of ratio
        (* The type of numbers. *)

let biggest_INT = big_int_of_int biggest_int
and least_INT = big_int_of_int least_int

(* Coercion big_int -> num *)
let num_of_big_int bi =
 if le_big_int bi biggest_INT && ge_big_int bi least_INT
 then Int (int_of_big_int bi)
 else Big_int bi

let numerator_num = function
  Ratio r -> ignore (normalize_ratio r); num_of_big_int (numerator_ratio r)
| n -> n

let denominator_num = function
  Ratio r -> ignore (normalize_ratio r); num_of_big_int (denominator_ratio r)
| n -> Int 1

let normalize_num = function
  Int i -> Int i
| Big_int bi -> num_of_big_int bi
| Ratio r -> if is_integer_ratio r
              then num_of_big_int (numerator_ratio r)
              else Ratio r

let cautious_normalize_num_when_printing n =
 if (!normalize_ratio_when_printing_flag) then (normalize_num n) else n

let num_of_ratio r =
 ignore (normalize_ratio r);
 if not (is_integer_ratio r) then Ratio r
 else if is_int_big_int (numerator_ratio r) then
        Int (int_of_big_int (numerator_ratio r))
 else Big_int (numerator_ratio r)

(* Operations on num *)

let add_num a b = match (a,b) with
    ((Int int1), (Int int2)) ->
      let r =  int1 + int2 in
      if (int1 lxor int2) lor (int1 lxor (r lxor (-1))) < 0
      then Int r                        (* No overflow *)
      else Big_int(add_big_int (big_int_of_int int1) (big_int_of_int int2))
  | ((Int i), (Big_int bi)) ->
      num_of_big_int (add_int_big_int i bi)
  | ((Big_int bi), (Int i)) ->
      num_of_big_int (add_int_big_int i bi)

  | ((Int i), (Ratio r)) ->
      Ratio (add_int_ratio i r)
  | ((Ratio r), (Int i)) ->
      Ratio (add_int_ratio i r)

  | ((Big_int bi1), (Big_int bi2)) -> num_of_big_int (add_big_int bi1 bi2)

  | ((Big_int bi), (Ratio r)) ->
      Ratio (add_big_int_ratio bi r)
  | ((Ratio r), (Big_int bi)) ->
      Ratio (add_big_int_ratio bi r)

  | ((Ratio r1), (Ratio r2)) -> num_of_ratio (add_ratio r1 r2)

let ( +/ ) = add_num

let minus_num = function
  Int i -> if i = monster_int
              then Big_int (minus_big_int (big_int_of_int i))
              else Int (-i)
| Big_int bi -> Big_int (minus_big_int bi)
| Ratio r -> Ratio (minus_ratio r)

let sub_num n1 n2 = add_num n1 (minus_num n2)

let ( -/ ) = sub_num

let mult_num a b = match (a,b) with
   ((Int int1), (Int int2)) ->
    if num_bits_int int1 + num_bits_int int2 < length_of_int
       then Int (int1 * int2)
       else num_of_big_int (mult_big_int (big_int_of_int int1)
                                         (big_int_of_int int2))

 | ((Int i), (Big_int bi)) ->
     num_of_big_int (mult_int_big_int i bi)
 | ((Big_int bi), (Int i)) ->
     num_of_big_int (mult_int_big_int i bi)

 | ((Int i), (Ratio r)) ->
     num_of_ratio (mult_int_ratio i r)
 | ((Ratio r), (Int i)) ->
     num_of_ratio (mult_int_ratio i r)

 | ((Big_int bi1), (Big_int bi2)) ->
     num_of_big_int (mult_big_int bi1 bi2)

 | ((Big_int bi), (Ratio r)) ->
     num_of_ratio (mult_big_int_ratio bi r)
 | ((Ratio r), (Big_int bi)) ->
     num_of_ratio (mult_big_int_ratio bi r)

 | ((Ratio r1), (Ratio r2)) ->
     num_of_ratio (mult_ratio r1 r2)

let ( */ ) = mult_num

let square_num = function
   Int i -> if 2 * num_bits_int i < length_of_int
               then Int (i * i)
               else num_of_big_int (square_big_int (big_int_of_int i))
 | Big_int bi -> Big_int (square_big_int bi)
 | Ratio r -> Ratio (square_ratio r)

let div_num n1 n2 =
 match n1 with
 | Int i1 ->
    begin match n2 with
    | Int i2 ->
       num_of_ratio (create_ratio (big_int_of_int i1) (big_int_of_int i2))
    | Big_int bi2 -> num_of_ratio (create_ratio (big_int_of_int i1) bi2)
    | Ratio r2 -> num_of_ratio (div_int_ratio i1 r2) end

 | Big_int bi1 ->
     begin match n2 with
     | Int i2 -> num_of_ratio (create_ratio bi1 (big_int_of_int i2))
     | Big_int bi2 -> num_of_ratio (create_ratio bi1 bi2)
     | Ratio r2 -> num_of_ratio (div_big_int_ratio bi1 r2) end

 | Ratio r1 ->
     begin match n2 with
     | Int i2 -> num_of_ratio (div_ratio_int r1 i2)
     | Big_int bi2 -> num_of_ratio (div_ratio_big_int r1 bi2)
     | Ratio r2 -> num_of_ratio (div_ratio r1 r2) end
;;

let ( // ) = div_num

let floor_num = function
  Int i as n -> n
| Big_int bi as n -> n
| Ratio r -> num_of_big_int (floor_ratio r)

(* The function [quo_num] is equivalent to

  let quo_num x y = floor_num (div_num x y);;

  However, this definition is vastly inefficient (cf PR #3473):
  we define here a better way of computing the same thing.
 *)
let quo_num n1 n2 =
 match n1 with
 | Int i1 ->
   begin match n2 with
   | Int i2 -> Int (i1 / i2)
   | Big_int bi2 -> num_of_big_int (div_big_int (big_int_of_int i1) bi2)
   | Ratio r2 -> num_of_big_int (floor_ratio (div_int_ratio i1 r2)) end

 | Big_int bi1 ->
   begin match n2 with
   | Int i2 -> num_of_big_int (div_big_int bi1 (big_int_of_int i2))
   | Big_int bi2 -> num_of_big_int (div_big_int bi1 bi2)
   | Ratio r2 -> num_of_big_int (floor_ratio (div_big_int_ratio bi1 r2)) end

 | Ratio r1 ->
   begin match n2 with
   | Int i2 -> num_of_big_int (floor_ratio (div_ratio_int r1 i2))
   | Big_int bi2 -> num_of_big_int (floor_ratio (div_ratio_big_int r1 bi2))
   | Ratio r2 -> num_of_big_int (floor_ratio (div_ratio r1 r2)) end
;;

(* The function [mod_num] is equivalent to:

  let mod_num x y = sub_num x (mult_num y (quo_num x y));;

  However, as for [quo_num] above, this definition is inefficient:
  we define here a better way of computing the same thing.
 *)
let mod_num n1 n2 =
 match n1 with
 | Int i1 ->
   begin match n2 with
   | Int i2 -> Int (i1 mod i2)
   | Big_int bi2 -> num_of_big_int (mod_big_int (big_int_of_int i1) bi2)
   | Ratio _r2 -> sub_num n1 (mult_num n2 (quo_num n1 n2)) end

 | Big_int bi1 ->
   begin match n2 with
   | Int i2 -> num_of_big_int (mod_big_int bi1 (big_int_of_int i2))
   | Big_int bi2 -> num_of_big_int (mod_big_int bi1 bi2)
   | Ratio _r2 -> sub_num n1 (mult_num n2 (quo_num n1 n2)) end

 | Ratio _r1 -> sub_num n1 (mult_num n2 (quo_num n1 n2))
;;

let power_num_int a b = match (a,b) with
   ((Int i), n) ->
       (match sign_int n with
           0 -> Int 1
         | 1 -> num_of_big_int (power_int_positive_int i n)
         | _ -> Ratio (create_normalized_ratio
                        unit_big_int (power_int_positive_int i (-n))))
| ((Big_int bi), n) ->
       (match sign_int n with
           0 -> Int 1
         | 1 -> num_of_big_int (power_big_int_positive_int bi n)
         | _ -> Ratio (create_normalized_ratio
                 unit_big_int (power_big_int_positive_int bi (-n))))
| ((Ratio r), n) ->
       (match sign_int n with
           0 -> Int 1
         | 1 -> Ratio (power_ratio_positive_int r n)
         | _ -> Ratio (power_ratio_positive_int
                         (inverse_ratio r) (-n)))

let power_num_big_int a b =  match (a,b) with
   ((Int i), n) ->
    (match sign_big_int n with
           0 -> Int 1
         | 1 -> num_of_big_int (power_int_positive_big_int i n)
         | _ -> Ratio (create_normalized_ratio
                         unit_big_int
                         (power_int_positive_big_int i (minus_big_int n))))
| ((Big_int bi), n) ->
       (match sign_big_int n with
           0 -> Int 1
         | 1 -> num_of_big_int (power_big_int_positive_big_int bi n)
         | _ -> Ratio (create_normalized_ratio
                         unit_big_int
                         (power_big_int_positive_big_int bi (minus_big_int n))))
| ((Ratio r), n) ->
       (match sign_big_int n with
           0 -> Int 1
         | 1 -> Ratio (power_ratio_positive_big_int r n)
         | _ -> Ratio (power_ratio_positive_big_int
                         (inverse_ratio r) (minus_big_int n)))

let power_num a b = match (a,b) with
  (n, (Int i)) -> power_num_int n i
| (n, (Big_int bi)) -> power_num_big_int n bi
| _ -> invalid_arg "power_num"

let ( **/ ) = power_num

let is_integer_num = function
  Int _     -> true
| Big_int _ -> true
| Ratio r   -> is_integer_ratio r

(* integer_num, floor_num, round_num, ceiling_num rendent des nums *)
let integer_num = function
  Int i as n -> n
| Big_int bi as n -> n
| Ratio r -> num_of_big_int (integer_ratio r)

and round_num = function
  Int i as n -> n
| Big_int bi as n -> n
| Ratio r -> num_of_big_int (round_ratio r)

and ceiling_num = function
  Int i as n -> n
| Big_int bi as n -> n
| Ratio r -> num_of_big_int (ceiling_ratio r)

(* Comparisons on nums *)

let sign_num = function
  Int i -> sign_int i
| Big_int bi -> sign_big_int bi
| Ratio r -> sign_ratio r

let eq_num a b = match (a,b) with
  ((Int int1), (Int int2)) -> int1 = int2

| ((Int i), (Big_int bi)) -> eq_big_int (big_int_of_int i) bi
| ((Big_int bi), (Int i)) -> eq_big_int (big_int_of_int i) bi

| ((Int i), (Ratio r)) -> eq_big_int_ratio (big_int_of_int i) r
| ((Ratio r), (Int i)) -> eq_big_int_ratio (big_int_of_int i) r

| ((Big_int bi1), (Big_int bi2)) -> eq_big_int bi1 bi2

| ((Big_int bi), (Ratio r)) -> eq_big_int_ratio bi r
| ((Ratio r), (Big_int bi)) -> eq_big_int_ratio bi r

| ((Ratio r1), (Ratio r2)) -> eq_ratio r1 r2

let ( =/ ) = eq_num

let ( <>/ ) a b = not(eq_num a b)

let compare_num a b = match (a,b) with
  ((Int int1), (Int int2)) -> compare_int int1 int2

| ((Int i), (Big_int bi)) -> compare_big_int (big_int_of_int i) bi
| ((Big_int bi), (Int i)) -> compare_big_int bi (big_int_of_int i)

| ((Int i), (Ratio r)) -> compare_big_int_ratio (big_int_of_int i) r
| ((Ratio r), (Int i)) -> -(compare_big_int_ratio (big_int_of_int i) r)

| ((Big_int bi1), (Big_int bi2)) -> compare_big_int bi1 bi2

| ((Big_int bi), (Ratio r)) -> compare_big_int_ratio bi r
| ((Ratio r), (Big_int bi)) -> -(compare_big_int_ratio bi r)

| ((Ratio r1), (Ratio r2)) -> compare_ratio r1 r2

let lt_num num1 num2 = compare_num num1 num2 < 0
and le_num num1 num2 = compare_num num1 num2 <= 0
and gt_num num1 num2 = compare_num num1 num2 > 0
and ge_num num1 num2 = compare_num num1 num2 >= 0

let ( </ ) = lt_num
and ( <=/ ) = le_num
and ( >/ ) = gt_num
and ( >=/ ) = ge_num

let max_num num1 num2 = if lt_num num1 num2 then num2 else num1
and min_num num1 num2 = if gt_num num1 num2 then num2 else num1

(* Coercions with basic types *)

(* Coercion with int type *)
let int_of_num = function
  Int i -> i
| Big_int bi -> int_of_big_int bi
| Ratio r -> int_of_ratio r

and num_of_int i =
  if i = monster_int
  then Big_int (big_int_of_int i)
  else Int i

(* Coercion with nat type *)
let nat_of_num = function
  Int i -> nat_of_int i
| Big_int bi -> nat_of_big_int bi
| Ratio r -> nat_of_ratio r

and num_of_nat nat =
  if (is_nat_int nat 0 (length_nat nat))
  then Int (nth_digit_nat nat 0)
  else Big_int (big_int_of_nat nat)

(* Coercion with big_int type *)
let big_int_of_num = function
  Int i -> big_int_of_int i
| Big_int bi -> bi
| Ratio r -> big_int_of_ratio r

(* Coercion with ratio type *)
let ratio_of_num = function
  Int i -> ratio_of_int i
| Big_int bi -> ratio_of_big_int bi
| Ratio r -> r
;;

let string_of_big_int_for_num bi =
  if !approx_printing_flag
     then approx_big_int !floating_precision bi
     else string_of_big_int bi

(* Coercion with string type *)

(* XL: suppression de sys_string_of_num *)

let string_of_normalized_num = function
  Int i -> string_of_int i
| Big_int bi -> string_of_big_int_for_num bi
| Ratio r -> string_of_ratio r
let string_of_num n =
    string_of_normalized_num (cautious_normalize_num_when_printing n)
let num_of_string s =
  try
    let flag = !normalize_ratio_flag in
    normalize_ratio_flag := true;
    let r = ratio_of_string s in
    normalize_ratio_flag := flag;
    if eq_big_int (denominator_ratio r) unit_big_int
    then num_of_big_int (numerator_ratio r)
    else Ratio r
  with Failure _ ->
    failwith "num_of_string"

(* Coercion with float type *)
let float_of_num = function
  Int i -> float i
| Big_int bi -> float_of_big_int bi
| Ratio r -> float_of_ratio r

(* XL: suppression de num_of_float, float_num *)

let succ_num = function
  Int i -> if i = biggest_int
              then Big_int (succ_big_int (big_int_of_int i))
              else Int (succ i)
| Big_int bi -> num_of_big_int (succ_big_int bi)
| Ratio r -> Ratio (add_int_ratio 1 r)

and pred_num = function
  Int i -> if i = monster_int
              then Big_int (pred_big_int (big_int_of_int i))
              else Int (pred i)
| Big_int bi -> num_of_big_int (pred_big_int bi)
| Ratio r -> Ratio (add_int_ratio (-1) r)

let abs_num = function
   Int i -> if i = monster_int
              then Big_int (minus_big_int (big_int_of_int i))
              else Int (abs i)
 | Big_int bi -> Big_int (abs_big_int bi)
 | Ratio r -> Ratio (abs_ratio r)

let approx_num_fix n num = approx_ratio_fix n (ratio_of_num num)
and approx_num_exp n num = approx_ratio_exp n (ratio_of_num num)

let incr_num r = r := succ_num !r
and decr_num r = r := pred_num !r