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
type 'a monoid = 'a * ('a -> 'a -> 'a)
let lift_monoid (zero, plus) =
(Lwd.return zero, Lwd.map2 ~f:plus)
let map_reduce inj (zero, plus) items =
let rec cons_monoid c xs v =
match xs with
| (c', v') :: xs when c = c' ->
cons_monoid (c + 1) xs (plus v' v)
| xs -> (c, v) :: xs
in
let cons_monoid xs v = cons_monoid 0 xs (inj v) in
match List.fold_left cons_monoid [] items with
| [] -> zero
| (_,x) :: xs ->
List.fold_left (fun acc (_, v) -> plus v acc) x xs
let reduce monoid items = map_reduce (fun x -> x) monoid items
let rec cons_lwd_monoid plus c xs v =
match xs with
| (c', v') :: xs when c = c' ->
cons_lwd_monoid plus (c + 1) xs (Lwd.map2 ~f:plus v' v)
| xs -> (c, v) :: xs
let pack (zero, plus) items =
match List.fold_left (cons_lwd_monoid plus 0) [] items with
| [] -> Lwd.return zero
| (_,x) :: xs ->
List.fold_left (fun acc (_, v) -> Lwd.map2 ~f:plus v acc) x xs
let pack_seq (zero, plus) items =
match Seq.fold_left (cons_lwd_monoid plus 0) [] items with
| [] -> Lwd.return zero
| (_,x) :: xs ->
List.fold_left (fun acc (_, v) -> Lwd.map2 ~f:plus v acc) x xs
let rec map_l (f:'a -> 'b Lwd.t) (l:'a list) : 'b list Lwd.t =
match l with
| [] -> Lwd.return []
| x :: tl -> Lwd.map2 ~f:List.cons (f x) (map_l f tl)
let flatten_l (l:'a Lwd.t list) : 'a list Lwd.t =
map_l (fun x->x) l
(** {1 Miscellaneous functions}
I don't know where to put these, but they are useful, especially for
UI-related computations.
*)
let mini a b : int = if b < a then b else a
let maxi a b : int = if b > a then b else a
let clampi x ~min ~max : int =
if x < min then
min
else if x > max then
max
else
x
let minf a b : float = if b < a then b else a
let maxf a b : float = if b > a then b else a
let clampf x ~min ~max : float =
if x < min then
min
else if x > max then
max
else
x