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
open Sexplib
let return = Lwt.return
let (>>=) = Lwt.(>>=)
let (>>|) = Lwt.(>|=)
module Body = Cohttp_lwt.Body
module Fn = struct
let compose f g x = f (g x)
let const x _ = x
end
module Option = struct
let some x = Some x
let is_some = function Some _ -> true | None -> false
let value ~default = function
| Some x -> x
| None -> default
let value_exn ~message = function
| Some x -> x
| None -> failwith message
let map ~f = function
| None -> None
| Some x -> Some (f x)
let map2 ~f a b = match a,b with
| Some x, Some y -> Some (f x y)
| _ -> None
let value_map ~default ~f = function
| None -> default
| Some x -> f x
let try_with f =
try Some (f ())
with _ -> None
end
module List = struct
include ListLabels
let rec filter_map ~f = function
| [] -> []
| x :: l ->
let l' = filter_map ~f l in
match f x with
| None -> l'
| Some y -> y :: l'
let is_empty = function [] -> true | _::_ -> false
let rec find_map ~f = function
| [] -> None
| x :: l ->
match f x with
| Some _ as res -> res
| None -> find_map ~f l
let rec filter_opt = function
| [] -> []
| None :: l -> filter_opt l
| Some x :: l -> x :: filter_opt l
let sexp_of_t sexp_of_elem l = Sexp.List (map l ~f:sexp_of_elem)
end
module String = struct
include String
let is_prefix ~prefix s =
String.length prefix <= String.length s &&
(let i = ref 0 in
while !i < String.length prefix && s.[!i] = prefix.[!i] do incr i done;
!i = String.length prefix)
let chop_prefix ~prefix s =
assert (is_prefix ~prefix s);
sub s (length prefix) (length s - length prefix)
let _is_sub ~sub i s j ~len =
let rec check k =
if k = len
then true
else sub.[i+k] = s.[j+k] && check (k+1)
in
j+len <= String.length s && check 0
let substr_index ~pattern:sub s =
let n = String.length sub in
let i = ref 0 in
try
while !i + n <= String.length s do
if _is_sub ~sub 0 s !i ~len:n then raise_notrace Exit;
incr i
done;
None
with Exit -> Some !i
end
module Queue = struct
include Queue
let find_map (type res) q ~f =
let module M = struct exception E of res end in
try
Queue.iter (fun x -> match f x with
| None -> ()
| Some y -> raise_notrace (M.E y))
q;
None
with M.E res -> Some res
let t_of_sexp elem_of_sexp s = match s with
| Sexp.List l ->
let q = create () in
List.iter ~f:(fun x -> push (elem_of_sexp x) q) l;
q
| Sexp.Atom _ -> raise (Conv.Of_sexp_error (Failure "expected list", s))
let sexp_of_t sexp_of_elem q =
let l = Queue.fold (fun acc x -> sexp_of_elem x :: acc) [] q in
Sexp.List (List.rev l)
end
let sexp_of_pair f1 f2 (x1,x2) = Sexp.List [f1 x1; f2 x2]
let hashtbl_add_multi tbl x y =
let l = try Hashtbl.find tbl x with Not_found -> [] in
Hashtbl.replace tbl x (y::l)