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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
module type S = Sigs.RANGE
module Make (Comp : Sigs.COMPARABLE) = struct
type elt = Comp.t
module Elt = struct
let equal a b = Int.equal (Comp.compare a b) 0
module E = struct
type t = Comp.t
let equal = equal
end
include Util.Make_compare_helpers (Comp)
include Util.Make_compare_infix (Comp)
include Util.Make_equal_infix (E)
end
type t =
{ first : elt
; last : elt
}
type iterator =
{ pred : elt -> elt
; succ : elt -> elt
}
let iterator ~pred ~succ = { pred; succ }
let linear_iterator f x =
let pred = f (-x)
and succ = f x in
iterator ~pred ~succ
;;
let make ~first ~last = { first; last }
let first_elt { first; _ } = first
let last_elt { last; _ } = last
let is_ascending r = Elt.(first_elt r <= last_elt r)
let is_descending r = Elt.(first_elt r >= last_elt r)
let is_singleton r = Elt.equal (first_elt r) (last_elt r)
let min_elt r = if is_ascending r then first_elt r else last_elt r
let max_elt r = if is_ascending r then last_elt r else first_elt r
let bounds r = min_elt r, max_elt r
let rev { first = last; last = first } = { first; last }
let sort r = if not (is_ascending r) then rev r else r
let equal a b =
Elt.equal (first_elt a) (first_elt b) && Elt.equal (last_elt a) (last_elt b)
;;
let contains x r =
let a, b = bounds r in
Elt.(x >= a && x <= b)
;;
let mem = contains
let overlaps ra rb =
let min1, max1 = bounds ra in
let min2, max2 = bounds rb in
not Elt.(max1 < min2 || max2 < min1)
;;
let disjoint ra rb = not (overlaps ra rb)
let includes parent r =
let f, l = bounds r in
contains f parent && contains l parent
;;
let shift f r =
let first = f (first_elt r)
and last = f (last_elt r) in
make ~first ~last
;;
let map = shift
let span ra rb =
let ma, mb = bounds ra
and na, nb = bounds rb in
let first = Elt.min ma na
and last = Elt.max mb nb in
make ~first ~last
;;
let intersection ra rb =
if not (overlaps ra rb)
then None
else (
let amin, amax = bounds ra
and bmin, bmax = bounds rb in
let first = Elt.max amin bmin
and last = Elt.min amax bmax in
Some (make ~first ~last))
;;
let clamp ~within r = intersection within r
let fold_left
?(include_boundaries = true)
~iterator:{ succ; pred }
f
acc
range
=
let curr = first_elt range in
let last = last_elt range in
let is_asc = is_ascending range in
let next_fn = if is_asc then succ else pred in
let rec aux curr acc =
if Elt.equal curr last
then f curr acc
else (
let next = next_fn curr in
if
(is_asc && (Elt.(next > last) || Elt.(next <= curr)))
|| ((not is_asc) && (Elt.(next < last) || Elt.(next >= curr)))
then if include_boundaries then f last (f curr acc) else f curr acc
else aux next (f curr acc))
in
aux curr acc
;;
let fold_right ?include_boundaries ~iterator f acc range =
fold_left ?include_boundaries ~iterator f acc (rev range)
;;
let length ?include_boundaries ~iterator =
fold_left ?include_boundaries ~iterator (fun _ x -> x + 1) 0
;;
let iter ?include_boundaries ~iterator f =
fold_left ?include_boundaries ~iterator (fun curr () -> f curr) ()
;;
let to_list ?include_boundaries ~iterator range =
range |> fold_left ?include_boundaries ~iterator List.cons [] |> List.rev
;;
let to_seq ?include_boundaries ~iterator range =
range |> to_list ?include_boundaries ~iterator |> List.to_seq
;;
module CE = struct
type nonrec t = t
let equal = equal
end
module Infix = struct
include Util.Make_equal_infix (CE)
end
include Infix
end