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
include Stdlib.List
include Module_types
type 'a t = 'a list
let return (a:'a): 'a t = [a]
let rec (>>=) (l:'a t) (f:'a -> 'b t): 'b t =
match l with
| [] ->
[]
| hd :: tl ->
f hd @ (tl >>= f)
let (>=>) (f:'a -> 'b t) (g:'b -> 'c t) (a:'a): 'c t =
f a >>= g
let (<*>) (flst: ('a -> 'b) t) (lst:'a t): 'b t =
flst >>= fun f -> map f lst
let join = concat
let find (p:'a -> bool) (l:'a t): 'a option =
try
Some (find p l)
with Not_found ->
None
let nth (i: int) (lst: 'a t): 'a option =
nth_opt lst i
let nth_strict (i: int) (lst: 'a t): 'a =
match nth i lst with
| None ->
assert false
| Some e ->
e
let map_and_filter (f:'a -> 'b option) (l:'a list): 'b list =
let rec map = function
| [] ->
[]
| hd :: tl ->
match f hd with
| None ->
map tl
| Some b ->
b :: map tl
in
map l
let split_at (p:'a -> bool) (l: 'a t): 'a t * 'a t =
let rec split prefix rest =
match rest with
| [] ->
rev prefix, rest
| hd :: tl ->
if p hd then
rev prefix, rest
else
split (hd :: prefix) tl
in
split [] l
module Monadic_fold (M:MONAD) =
struct
let foldi_left (f:int -> 'a -> 'b -> 'b M.t) (l:'a t) (start:'b)
: 'b M.t =
let rec foldi i l start =
match l with
| [] ->
M.return start
| hd :: tl ->
M.(f i hd start >>= foldi (i+1) tl)
in
foldi 0 l start
let fold_left (f:'a -> 'b -> 'b M.t) (l:'a t) (start:'b): 'b M.t =
foldi_left (fun _ -> f) l start
let fold_right (f:'a -> 'b -> 'b M.t) (l:'a t) (start:'b): 'b M.t =
fold_left f (rev l) start
end