Source file sign_or_nan.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
open! Import
module T = struct
type t =
| Neg
| Zero
| Pos
| Nan
[@@deriving_inline sexp, compare, hash, enumerate]
let t_of_sexp =
(let _tp_loc = "sign_or_nan.ml.T.t" in
function
| Ppx_sexp_conv_lib.Sexp.Atom ("neg" | "Neg") -> Neg
| Ppx_sexp_conv_lib.Sexp.Atom ("zero" | "Zero") -> Zero
| Ppx_sexp_conv_lib.Sexp.Atom ("pos" | "Pos") -> Pos
| Ppx_sexp_conv_lib.Sexp.Atom ("nan" | "Nan") -> Nan
| Ppx_sexp_conv_lib.Sexp.List (Ppx_sexp_conv_lib.Sexp.Atom ("neg" | "Neg") :: _) as
sexp -> Ppx_sexp_conv_lib.Conv_error.stag_no_args _tp_loc sexp
| Ppx_sexp_conv_lib.Sexp.List (Ppx_sexp_conv_lib.Sexp.Atom ("zero" | "Zero") :: _)
as sexp -> Ppx_sexp_conv_lib.Conv_error.stag_no_args _tp_loc sexp
| Ppx_sexp_conv_lib.Sexp.List (Ppx_sexp_conv_lib.Sexp.Atom ("pos" | "Pos") :: _) as
sexp -> Ppx_sexp_conv_lib.Conv_error.stag_no_args _tp_loc sexp
| Ppx_sexp_conv_lib.Sexp.List (Ppx_sexp_conv_lib.Sexp.Atom ("nan" | "Nan") :: _) as
sexp -> Ppx_sexp_conv_lib.Conv_error.stag_no_args _tp_loc sexp
| Ppx_sexp_conv_lib.Sexp.List (Ppx_sexp_conv_lib.Sexp.List _ :: _) as sexp ->
Ppx_sexp_conv_lib.Conv_error.nested_list_invalid_sum _tp_loc sexp
| Ppx_sexp_conv_lib.Sexp.List [] as sexp ->
Ppx_sexp_conv_lib.Conv_error.empty_list_invalid_sum _tp_loc sexp
| sexp -> Ppx_sexp_conv_lib.Conv_error.unexpected_stag _tp_loc sexp
: Ppx_sexp_conv_lib.Sexp.t -> t)
;;
let sexp_of_t =
(function
| Neg -> Ppx_sexp_conv_lib.Sexp.Atom "Neg"
| Zero -> Ppx_sexp_conv_lib.Sexp.Atom "Zero"
| Pos -> Ppx_sexp_conv_lib.Sexp.Atom "Pos"
| Nan -> Ppx_sexp_conv_lib.Sexp.Atom "Nan"
: t -> Ppx_sexp_conv_lib.Sexp.t)
;;
let compare = (Ppx_compare_lib.polymorphic_compare : t -> t -> int)
let (hash_fold_t : Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state) =
(fun hsv arg ->
match arg with
| Neg -> Ppx_hash_lib.Std.Hash.fold_int hsv 0
| Zero -> Ppx_hash_lib.Std.Hash.fold_int hsv 1
| Pos -> Ppx_hash_lib.Std.Hash.fold_int hsv 2
| Nan -> Ppx_hash_lib.Std.Hash.fold_int hsv 3
: Ppx_hash_lib.Std.Hash.state -> t -> Ppx_hash_lib.Std.Hash.state)
;;
let (hash : t -> Ppx_hash_lib.Std.Hash.hash_value) =
let func arg =
Ppx_hash_lib.Std.Hash.get_hash_value
(let hsv = Ppx_hash_lib.Std.Hash.create () in
hash_fold_t hsv arg)
in
fun x -> func x
;;
let all = ([ Neg; Zero; Pos; Nan ] : t list)
[@@@end]
let of_string s = t_of_sexp (sexp_of_string s)
let to_string t = string_of_sexp (sexp_of_t t)
let module_name = "Base.Sign_or_nan"
end
module Replace_polymorphic_compare = struct
let ( < ) (x : T.t) y = Poly.( < ) x y
let ( <= ) (x : T.t) y = Poly.( <= ) x y
let ( <> ) (x : T.t) y = Poly.( <> ) x y
let ( = ) (x : T.t) y = Poly.( = ) x y
let ( > ) (x : T.t) y = Poly.( > ) x y
let ( >= ) (x : T.t) y = Poly.( >= ) x y
let ascending (x : T.t) y = Poly.ascending x y
let descending (x : T.t) y = Poly.descending x y
let compare (x : T.t) y = Poly.compare x y
let equal (x : T.t) y = Poly.equal x y
let max (x : T.t) y = if x >= y then x else y
let min (x : T.t) y = if x <= y then x else y
end
include T
include Identifiable.Make (T)
open! Replace_polymorphic_compare
let of_sign = function
| Sign.Neg -> Neg
| Sign.Zero -> Zero
| Sign.Pos -> Pos
;;
let to_sign_exn = function
| Neg -> Sign.Neg
| Zero -> Sign.Zero
| Pos -> Sign.Pos
| Nan -> invalid_arg "Base.Sign_or_nan.to_sign_exn: Nan"
;;
let of_int n = of_sign (Sign.of_int n)
let to_int_exn t = Sign.to_int (to_sign_exn t)
let flip = function
| Neg -> Pos
| Zero -> Zero
| Pos -> Neg
| Nan -> Nan
;;
let ( * ) t t' =
match t, t' with
| Nan, _ | _, Nan -> Nan
| _ -> of_sign (Sign.( * ) (to_sign_exn t) (to_sign_exn t'))
;;
include Replace_polymorphic_compare