Commit d36f20d0 authored by Loïc Correnson's avatar Loïc Correnson
Browse files

[libs] lint floating-point utils

parent 319e6d2f
......@@ -145,8 +145,6 @@ ML_LINT_KO+=src/libraries/utils/command.ml
ML_LINT_KO+=src/libraries/utils/command.mli
ML_LINT_KO+=src/libraries/utils/escape.mli
ML_LINT_KO+=src/libraries/utils/filepath.ml
ML_LINT_KO+=src/libraries/utils/floating_point.ml
ML_LINT_KO+=src/libraries/utils/floating_point.mli
ML_LINT_KO+=src/libraries/utils/hook.ml
ML_LINT_KO+=src/libraries/utils/hook.mli
ML_LINT_KO+=src/libraries/utils/hptmap.ml
......
......@@ -41,10 +41,10 @@ external set_rounding_mode: c_rounding_mode -> unit = "set_rounding_mode" "noall
[@@@ warning "+3"]
external round_to_single_precision_float: float -> float = "round_to_float"
external sys_single_precision_of_string: string -> float =
"single_precision_of_string"
(* TODO two functions above: declare "float",
external round_to_single_precision_float: float -> float = "round_to_float"
external sys_single_precision_of_string: string -> float =
"single_precision_of_string"
(* TODO two functions above: declare "float",
must have separate version for bytecode, see OCaml manual *)
let max_single_precision_float = Int32.float_of_bits 0x7f7fffffl
......@@ -56,16 +56,16 @@ type parsed_float = {
f_upper : float ;
}
let inf ~man_size ~max_exp =
let inf ~man_size ~max_exp =
let biggest_not_inf = ldexp (2.0 -. ldexp 1.0 (~- man_size)) max_exp in
{
{
f_lower = biggest_not_inf ;
f_nearest = infinity ;
f_upper = infinity ;
}
(* [s = num * 2^exp / den] hold *)
let make_float ~num ~den ~exp ~man_size ~min_exp ~max_exp =
let make_float ~num ~den ~exp ~man_size ~min_exp ~max_exp =
assert (Integer.gt num Integer.zero);
assert (Integer.gt den Integer.zero);
(*
......@@ -78,7 +78,7 @@ let make_float ~num ~den ~exp ~man_size ~min_exp ~max_exp =
let den = ref den in
let exp = ref exp in
while
while
Integer.ge num (Integer.shift_left !den ssize_bi)
|| !exp < min_exp
do
......@@ -88,7 +88,7 @@ let make_float ~num ~den ~exp ~man_size ~min_exp ~max_exp =
let den = !den in
let shifted_den = Integer.shift_left den size_bi in
let num = ref num in
while
while
Integer.lt !num shifted_den && !exp > min_exp
do
num := Integer.shift_left !num Integer.one;
......@@ -96,7 +96,7 @@ let make_float ~num ~den ~exp ~man_size ~min_exp ~max_exp =
done;
let num = !num in
let exp = !exp in
(*
(*
Format.printf "make_float2: num den exp:@\n%a@\n@\n%a@\n@\n%d@."
Datatype.Integer.pretty num Datatype.Integer.pretty den exp;
*)
......@@ -107,9 +107,9 @@ let make_float ~num ~den ~exp ~man_size ~min_exp ~max_exp =
Integer.shift_left rem Integer.one
in
let man = Integer.to_int64 man in
(* Format.printf "pre-round: num den man rem:@\n%a@\n@\n%a@\n@\n%Ld@\n@\n%a@."
Datatype.Integer.pretty num Datatype.Integer.pretty den
man Datatype.Integer.pretty rem; *)
(* Format.printf "pre-round: num den man rem:@\n%a@\n@\n%a@\n@\n%Ld@\n@\n%a@."
Datatype.Integer.pretty num Datatype.Integer.pretty den
man Datatype.Integer.pretty rem; *)
let lowb = ldexp (Int64.to_float man) exp in
if Integer.is_zero rem2 then {
f_lower = lowb ;
......@@ -118,16 +118,16 @@ let make_float ~num ~den ~exp ~man_size ~min_exp ~max_exp =
} else
let upb = ldexp (Int64.to_float (Int64.succ man)) exp in
if Integer.lt rem2 den ||
(Integer.equal rem2 den && (Int64.logand man Int64.one) = 0L)
(Integer.equal rem2 den && (Int64.logand man Int64.one) = 0L)
then {
f_lower = lowb ;
f_nearest = lowb ;
f_upper = upb ;
f_lower = lowb ;
f_nearest = lowb ;
f_upper = upb ;
}
else {
f_lower = lowb ;
f_nearest = upb ;
f_upper = upb ;
f_lower = lowb ;
f_nearest = upb ;
f_upper = upb ;
}
let reg_exp = "[eE][+]?\\(-?[0-9]+\\)"
......@@ -154,66 +154,66 @@ let parse_float ~man_size ~min_exp ~max_exp s =
with Failure _ ->
(* Format.printf "Error in exponent: %s@." s; *)
if s.[0] = '-'
then raise (Shortcut {
f_lower = 0.0 ;
f_nearest = 0.0 ;
f_upper = ldexp 1.0 (min_exp - man_size) ;
})
then raise (Shortcut {
f_lower = 0.0 ;
f_nearest = 0.0 ;
f_upper = ldexp 1.0 (min_exp - man_size) ;
})
else raise (Shortcut (inf ~man_size ~max_exp))
in
try
(* At the end of the function, [s = num * 2^exp / den] *)
let num, den, exp =
if Str.string_match numdotfracexp s 0
then
let n = Str.matched_group 1 s in
let frac = Str.matched_group 2 s in
let len_frac = String.length frac in
let num = Integer.of_string (n ^ frac) in
let den = Integer.power_int_positive_int 5 len_frac in
if Integer.is_zero num then raise (Shortcut zero);
let exp10 = match_exp 3
in
if exp10 >= 0
then
Integer.mul num (Integer.power_int_positive_int 5 exp10),
den,
exp10 - len_frac
else
num,
Integer.mul den (Integer.power_int_positive_int 5 (~- exp10)),
exp10 - len_frac
else if Str.string_match numdotfrac s 0
then
let n = Str.matched_group 1 s in
let frac = Str.matched_group 2 s in
let len_frac = String.length frac in
Integer.of_string (n ^ frac),
Integer.power_int_positive_int 5 len_frac,
~- len_frac
else if Str.string_match numexp s 0
then
let n = Str.matched_group 1 s in
let num = Integer.of_string n in
if Integer.is_zero num then raise (Shortcut zero);
let exp10 = match_exp 2 in
if exp10 >= 0
then
Integer.mul num (Integer.power_int_positive_int 5 exp10),
Integer.one,
exp10
else
num,
(Integer.power_int_positive_int 5 (~- exp10)),
exp10
else (Format.printf "Could not parse floating point number %S@." s;
assert false)
in
if Integer.is_zero num
then zero
else
make_float ~num ~den ~exp ~man_size ~min_exp ~max_exp
with Shortcut r -> r
try
(* At the end of the function, [s = num * 2^exp / den] *)
let num, den, exp =
if Str.string_match numdotfracexp s 0
then
let n = Str.matched_group 1 s in
let frac = Str.matched_group 2 s in
let len_frac = String.length frac in
let num = Integer.of_string (n ^ frac) in
let den = Integer.power_int_positive_int 5 len_frac in
if Integer.is_zero num then raise (Shortcut zero);
let exp10 = match_exp 3
in
if exp10 >= 0
then
Integer.mul num (Integer.power_int_positive_int 5 exp10),
den,
exp10 - len_frac
else
num,
Integer.mul den (Integer.power_int_positive_int 5 (~- exp10)),
exp10 - len_frac
else if Str.string_match numdotfrac s 0
then
let n = Str.matched_group 1 s in
let frac = Str.matched_group 2 s in
let len_frac = String.length frac in
Integer.of_string (n ^ frac),
Integer.power_int_positive_int 5 len_frac,
~- len_frac
else if Str.string_match numexp s 0
then
let n = Str.matched_group 1 s in
let num = Integer.of_string n in
if Integer.is_zero num then raise (Shortcut zero);
let exp10 = match_exp 2 in
if exp10 >= 0
then
Integer.mul num (Integer.power_int_positive_int 5 exp10),
Integer.one,
exp10
else
num,
(Integer.power_int_positive_int 5 (~- exp10)),
exp10
else (Format.printf "Could not parse floating point number %S@." s;
assert false)
in
if Integer.is_zero num
then zero
else
make_float ~num ~den ~exp ~man_size ~min_exp ~max_exp
with Shortcut r -> r
let is_hex s =
let l = String.length s in
......@@ -224,7 +224,7 @@ let opp_parse_float f =
let rec single_precision_of_string s =
if s.[0] = '-' then
opp_parse_float (single_precision_of_string (String.sub s 1 (String.length s - 1)))
opp_parse_float (single_precision_of_string (String.sub s 1 (String.length s - 1)))
else if is_hex s
then
try
......@@ -236,11 +236,11 @@ let rec single_precision_of_string s =
parse_float ~man_size:23 ~min_exp:(-126) ~max_exp:127 s
(* May raise Failure("float_of_string"). *)
let rec double_precision_of_string s =
let rec double_precision_of_string s =
if s.[0] = '-' then
opp_parse_float (double_precision_of_string (String.sub s 1 (String.length s - 1)))
else if is_hex s
then
then
let f = float_of_string s in
{ f_lower = f ; f_nearest = f ; f_upper = f }
else (* decimal *)
......@@ -285,62 +285,62 @@ let pretty_normal ~use_hex fmt f =
let s = if s then "-" else "" in
if exp = 2047
then begin
if man = 0L
then
Format.fprintf fmt "%sinf" s
else
Format.fprintf fmt "NaN"
end
if man = 0L
then
Format.fprintf fmt "%sinf" s
else
Format.fprintf fmt "NaN"
end
else
let firstdigit, exp =
if exp <> 0
then 1, (exp - 1023)
else 0, if f = 0. then 0 else -1022
in
if not use_hex
then begin
let firstdigit, exp =
if exp <> 0
then 1, (exp - 1023)
else 0, if f = 0. then 0 else -1022
in
if not use_hex
then begin
let firstdigit, man, exp =
if 0 < exp && exp <= 12
then begin
Int64.to_int
(Int64.shift_right_logical
(Int64.logor man double_norm)
(52 - exp)),
Int64.logand (Int64.shift_left man exp) double_mask,
0
end
else firstdigit, man, exp
if 0 < exp && exp <= 12
then begin
Int64.to_int
(Int64.shift_right_logical
(Int64.logor man double_norm)
(52 - exp)),
Int64.logand (Int64.shift_left man exp) double_mask,
0
end
else firstdigit, man, exp
in
let d =
Int64.float_of_bits
(Int64.logor 0x3ff0000000000000L man)
Int64.float_of_bits
(Int64.logor 0x3ff0000000000000L man)
in
let d, re =
if d >= 1.5
then d -. 1.5, 5000000000000000L
else d -. 1.0, 0L
if d >= 1.5
then d -. 1.5, 5000000000000000L
else d -. 1.0, 0L
in
let d = d *. 1e16 in
let decdigits = Int64.add re (Int64.of_float d) in
if exp = 0 || (firstdigit = 0 && decdigits = 0L && exp = -1022)
then
Format.fprintf fmt "%s%d.%016Ld"
s
firstdigit
decdigits
Format.fprintf fmt "%s%d.%016Ld"
s
firstdigit
decdigits
else
Format.fprintf fmt "%s%d.%016Ld*2^%d"
s
firstdigit
decdigits
exp
Format.fprintf fmt "%s%d.%016Ld*2^%d"
s
firstdigit
decdigits
exp
end
else
Format.fprintf fmt "%s0x%d.%013Lxp%d"
s
firstdigit
man
exp
else
Format.fprintf fmt "%s0x%d.%013Lxp%d"
s
firstdigit
man
exp
let pretty fmt f =
let use_hex = Kernel.FloatHex.get() in
......@@ -354,15 +354,15 @@ let pretty fmt f =
then
pretty_normal ~use_hex fmt f
else begin
let r = Format.sprintf "%.*g" 12 f in
if (String.contains r '.' || String.contains r 'e' ||
String.contains r 'E')
|| (match classify_float f with
| FP_normal | FP_subnormal | FP_zero -> false
| FP_infinite | FP_nan -> true)
then Format.pp_print_string fmt r
else Format.fprintf fmt "%s." r
end
let r = Format.sprintf "%.*g" 12 f in
if (String.contains r '.' || String.contains r 'e' ||
String.contains r 'E')
|| (match classify_float f with
| FP_normal | FP_subnormal | FP_zero -> false
| FP_infinite | FP_nan -> true)
then Format.pp_print_string fmt r
else Format.fprintf fmt "%s." r
end
type sign = Neg | Pos
......@@ -373,12 +373,12 @@ exception Float_Non_representable_as_Int64 of sign
raise Float_Non_representable_as_Int64. This is the most reasonable as
a floating-point number may represent an exponentially large integer. *)
let truncate_to_integer =
let min_64_float = -9.22337203685477581e+18
(* Int64.to_float (-0x8000000000000000L) *)
let min_64_float = -9.22337203685477581e+18
(* Int64.to_float (-0x8000000000000000L) *)
in
let max_64_float = 9.22337203685477478e+18
(* let open Int64 in
float_of_bits (pred (bits_of_float (to_float max_int))) *)
let max_64_float = 9.22337203685477478e+18
(* let open Int64 in
float_of_bits (pred (bits_of_float (to_float max_int))) *)
in
fun x ->
let max_64_float = Extlib.id max_64_float in
......@@ -388,10 +388,10 @@ let truncate_to_integer =
then raise (Float_Non_representable_as_Int64 Pos);
if x <= max_64_float then
Integer.of_int64 (Int64.of_float x)
else
Integer.add
(Integer.of_int64 (Int64.of_float (x +. min_64_float)))
(Integer.two_power_of_int 63)
else
Integer.add
(Integer.of_int64 (Int64.of_float (x +. min_64_float)))
(Integer.two_power_of_int 63)
let bits_of_max_double =
Integer.of_int64 (Int64.bits_of_float max_float)
......
......@@ -30,8 +30,8 @@ val string_of_c_rounding_mode : c_rounding_mode -> string
external set_round_downward : unit -> unit = "set_round_downward" [@@noalloc]
external set_round_upward : unit -> unit = "set_round_upward" [@@noalloc]
external set_round_nearest_even : unit -> unit =
"set_round_nearest_even" [@@noalloc]
external set_round_nearest_even : unit -> unit =
"set_round_nearest_even" [@@noalloc]
external set_round_toward_zero : unit -> unit =
"set_round_toward_zero" [@@noalloc]
external get_rounding_mode: unit -> c_rounding_mode =
......@@ -49,8 +49,8 @@ val neg_min_denormal: float
val min_single_precision_denormal: float
val neg_min_single_precision_denormal: float
external sys_single_precision_of_string: string -> float =
"single_precision_of_string"
external sys_single_precision_of_string: string -> float =
"single_precision_of_string"
(** If [s] is parsed as [(n, l, u)], then [n] is the nearest approximation of
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment