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
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Pierre Chambart, OCamlPro *)
(* Mark Shinwell and Leo White, Jane Street Europe *)
(* *)
(* Copyright 2013--2016 OCamlPro SAS *)
(* Copyright 2014--2016 Jane Street Group LLC *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
[@@@ocaml.warning "+a-4-9-30-40-41-42-66"]
open! Int_replace_polymorphic_compare
type t =
| Float of float
| Int32 of int32
| Int64 of int64
| Nativeint of nativeint
| Float_array of float list
| Immutable_float_array of float list
| String of string
| Immutable_string of string
let compare_floats x1 x2 =
(* It is important to compare the bit patterns here, so as not to
be subject to bugs such as GPR#295. *)
Int64.compare (Int64.bits_of_float x1) (Int64.bits_of_float x2)
let compare (x : t) (y : t) =
let rec compare_float_lists l1 l2 =
match l1, l2 with
| [], [] -> 0
| [], _::_ -> -1
| _::_, [] -> 1
| h1::t1, h2::t2 ->
let c = compare_floats h1 h2 in
if c <> 0 then c else compare_float_lists t1 t2
in
match x, y with
| Float x, Float y -> compare_floats x y
| Int32 x, Int32 y -> Int32.compare x y
| Int64 x, Int64 y -> Int64.compare x y
| Nativeint x, Nativeint y -> Nativeint.compare x y
| Float_array x, Float_array y -> compare_float_lists x y
| Immutable_float_array x, Immutable_float_array y -> compare_float_lists x y
| String x, String y -> String.compare x y
| Immutable_string x, Immutable_string y -> String.compare x y
| Float _, _ -> -1
| _, Float _ -> 1
| Int32 _, _ -> -1
| _, Int32 _ -> 1
| Int64 _, _ -> -1
| _, Int64 _ -> 1
| Nativeint _, _ -> -1
| _, Nativeint _ -> 1
| Float_array _, _ -> -1
| _, Float_array _ -> 1
| Immutable_float_array _, _ -> -1
| _, Immutable_float_array _ -> 1
| String _, _ -> -1
| _, String _ -> 1
let print ppf (t : t) =
let fprintf = Format.fprintf in
let floats ppf fl =
List.iter (fun f -> fprintf ppf "@ %f" f) fl
in
match t with
| String s -> fprintf ppf "%S" s
| Immutable_string s -> fprintf ppf "#%S" s
| Int32 n -> fprintf ppf "%lil" n
| Int64 n -> fprintf ppf "%LiL" n
| Nativeint n -> fprintf ppf "%nin" n
| Float f -> fprintf ppf "%f" f
| Float_array [] -> fprintf ppf "[| |]"
| Float_array (f1 :: fl) ->
fprintf ppf "@[<1>[|@[%f%a@]|]@]" f1 floats fl
| Immutable_float_array [] -> fprintf ppf "[|# |]"
| Immutable_float_array (f1 :: fl) ->
fprintf ppf "@[<1>[|# @[%f%a@]|]@]" f1 floats fl
|
