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
let remove_suffix_after_last_occurrence p list =
let rec aux list buffer output =
match list with
| h :: t when p h -> aux t [] ((h :: buffer) :: output)
| h :: t -> aux t (h :: buffer) output
| [] -> output
in
let rev_concat list =
List.fold_left (List.fold_left (fun output a -> a :: output)) [] list
in
rev_concat (aux list [] [])
let rec last = function
| [] -> failwith "list_last"
| [ x ] -> x
| _ :: l -> last l
let rec aux_pop_last acc = function
| [] -> failwith "list_pop_last"
| [ x ] -> List.rev acc, x
| h :: t -> aux_pop_last (h :: acc) t
let pop_last l = aux_pop_last [] l
let cons_option h t =
match h with
| Some x -> x :: t
| None -> t
let rec smart_filter f = function
| t :: q as l ->
let q' = smart_filter f q in
if f t then
if q == q' then
l
else
t :: q'
else
q'
| l -> l
let rec smart_map f = function
| t :: q as l ->
let q' = smart_map f q in
let t' = f t in
if t' == t && q' == q then
l
else
t' :: q'
| l -> l
let rev_mapi f l =
let rec aux_mapi i acc = function
| [] -> acc
| h :: q -> aux_mapi (pred i) (f i h :: acc) q
in
aux_mapi (List.length l - 1) [] l
let rec map_option f = function
| [] -> []
| h :: q -> cons_option (f h) (map_option f q)
let exists_uniq f l =
let rec second = function
| [] -> true
| h :: t -> (not (f h)) && second t
in
let rec first = function
| [] -> false
| h :: t ->
if f h then
second t
else
first t
in
first l
let merge_uniq cmp l1 l2 =
let rec aux_merge_uniq l1 l2 k =
match l1, l2 with
| [], _ -> k l2
| _, [] -> k l1
| h1 :: t1, h2 :: t2 ->
let c = cmp h1 h2 in
if c < 0 then
aux_merge_uniq t1 l2 (fun o ->
if o == t1 then
k l1
else
k (h1 :: o))
else if c > 0 then
aux_merge_uniq l1 t2 (fun o ->
if o == t2 then
k l2
else
k (h2 :: o))
else
aux_merge_uniq t1 t2 (fun o ->
if o == t1 then
k l1
else
k (h1 :: o))
in
aux_merge_uniq l1 l2 (fun x -> x)
let rec rev_map_append f l acc =
match l with
| [] -> acc
| h :: t -> rev_map_append f t (f h :: acc)
let rec map_flatten f = function
| [] -> []
| h :: t -> List.append (f h) (map_flatten f t)
let remove_consecutive_double l =
let rec aux last l acc =
match l with
| h :: q when last = h -> aux last q acc
| h :: q -> aux h q (h :: acc)
| [] -> List.rev acc
in
match l with
| [] -> []
| h :: q -> aux h q [ h ]
let rec fold_right_map f l x =
match l with
| [] -> [], x
| h :: t ->
let t', x' = fold_right_map f t x in
let h', x'' = f h x' in
h' :: t', x''
let rec fold_left2 f x l1 l2 =
match l1, l2 with
| [], [] -> x
| [], _ :: _ | _ :: _, [] -> raise (Invalid_argument "list_fold_left2")
| h1 :: t1, h2 :: t2 -> fold_left2 f (f x h1 h2) t1 t2
let random rs l = List.nth l (Random.State.int rs (List.length l))
let find_option (p : 'a -> bool) (l : 'a list) : 'a option =
try Some (List.find p l) with Not_found -> None
module Infix = struct
let ( $$ ) = cons_option
end