Source file `maybe_bound.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
open! Import

module Stable = struct
  module V1 = struct
    type 'a t = 'a Base.Maybe_bound.t =
      | Incl of 'a
      | Excl of 'a
      | Unbounded
    [@@deriving bin_io, compare, sexp]

    let map x ~f =
      match x with
      | Incl x -> Incl (f x)
      | Excl x -> Excl (f x)
      | Unbounded -> Unbounded
    ;;
  end
end

include Base.Maybe_bound

type 'a t = 'a Stable.V1.t =
  | Incl of 'a
  | Excl of 'a
  | Unbounded
[@@deriving bin_io, compare, quickcheck, sexp]

let compare_one_sided ~side compare_a t1 t2 =
  match t1, t2 with
  | Unbounded, Unbounded -> 0
  | Unbounded, _ ->
    (match side with
     | `Lower -> -1
     | `Upper -> 1)
  | _, Unbounded ->
    (match side with
     | `Lower -> 1
     | `Upper -> -1)
  | Incl a1, Incl a2 -> compare_a a1 a2
  | Excl a1, Excl a2 -> compare_a a1 a2
  | Incl a1, Excl a2 ->
    let c = compare_a a1 a2 in
    if c = 0
    then (
      match side with
      | `Lower -> -1
      | `Upper -> 1)
    else c
  | Excl a1, Incl a2 ->
    let c = compare_a a1 a2 in
    if c = 0
    then (
      match side with
      | `Lower -> 1
      | `Upper -> -1)
    else c
;;

module As_lower_bound = struct
  type nonrec 'a t = 'a t

  let compare compare_a t1 t2 = compare_one_sided ~side:`Lower compare_a t1 t2
end

module As_upper_bound = struct
  type nonrec 'a t = 'a t

  let compare compare_a t1 t2 = compare_one_sided ~side:`Upper compare_a t1 t2
end