diff options
Diffstat (limited to 'otherlibs/num/num.ml')
| -rw-r--r-- | otherlibs/num/num.ml | 396 |
1 files changed, 0 insertions, 396 deletions
diff --git a/otherlibs/num/num.ml b/otherlibs/num/num.ml deleted file mode 100644 index 3d53aefdf8..0000000000 --- a/otherlibs/num/num.ml +++ /dev/null @@ -1,396 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* 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 -> normalize_ratio r; num_of_big_int (numerator_ratio r) -| n -> n - -let denominator_num = function - Ratio r -> 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 = - 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) - -let quo_num x y = floor_num (div_num x y) - -let mod_num x y = sub_num x (mult_num y (quo_num x y)) - -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 - - - - - |