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
module StringSet = Set.Make (String)
module StringMap = Map.Make (String)
module IntMap = Map.Make (struct
type t = int
let compare i j = i - j
end)
module IntSet = Set.Make (struct
type t = int
let compare i j = i - j
end)
let string_of_list sep to_string = function
| [] -> ""
| [ a ] -> to_string a
| a :: tl ->
let buf = Buffer.create 16 in
let () = Buffer.add_string buf (to_string a) in
let () =
List.iter
(fun s ->
Buffer.add_string buf (Printf.sprintf "%s%s" sep (to_string s)))
tl
in
Buffer.contents buf
let rec intersperse (sep : 'a) : 'a list -> 'a list = function
| [] -> []
| [ a_1 ] -> [ a_1 ]
| a_1 :: a_2 :: tl -> a_1 :: sep :: intersperse sep (a_2 :: tl)
let cycle (n : int) (xs : 'a list) : 'a list =
let rec cycle_aux n ys acc =
match (n, ys) with
| 0, _ -> acc
| _, [] -> cycle_aux n xs acc
| _, hd :: tl -> cycle_aux (n - 1) tl (hd :: acc)
in
match xs with [] -> [] | _ -> List.rev @@ cycle_aux n xs []
let fold_left1 (f : 'a -> 'a -> 'a) (xs : 'a list) : 'a =
match xs with
| [] -> failwith "Empty list passed to fold_left1"
| head :: tail -> List.fold_left f head tail
let string_of_list_rev sep to_string lst =
let buf = Buffer.create 16 in
let rec string_of_list_rev_rec k = function
| [] -> k ()
| [ a ] ->
let () = Buffer.add_string buf (to_string a) in
k ()
| a :: tl ->
string_of_list_rev_rec
(fun () ->
let () =
Buffer.add_string buf (Printf.sprintf "%s%s" sep (to_string a))
in
k ())
tl
in
let () = string_of_list_rev_rec (fun () -> ()) lst in
Buffer.contents buf
module FileErrors_l =
struct
type t =
| FileNotFound of string
| IsADirectory of string
let kind = "File"
let pp fmt = function
| FileNotFound f -> Format.fprintf fmt "Can't@ open@ file@ \"%s\"@ (not@ found)" f
| IsADirectory d -> Format.fprintf fmt "Can't@ open@ file@ \"%s\"@ (it@ is@ a@ directory)" d
end
module FileErrors = Error.ErrorManager(FileErrors_l)
(** [find_file f dirs msg] tries to find a file with the name [f] in
the directories listed in [dirs]. If it finds it in [dir], it
returns the full name [Filename.concat dir f]. To check in the
current directory, add [""] to the list. It tries in the
directories of [dirs] in this order and stops when it finds such
a file. If it can't find any such file, raise the exception
{!Utils.No_file(f,msg)}. Moreover, if [f] starts with ["/"] or
["./"] or ["../"] then it checks wheter [f] exists only in the
current directory.*)
let find_file name dirs loc =
let regexp = Str.regexp "\\(^\\./\\)\\|\\(^\\.\\./\\)\\|\\(^/\\)" in
let check_dirs = not (Str.string_match regexp name 0) in
let get_name f =
if Sys.file_exists f then
if not (Sys.is_directory f) then Some f
else FileErrors.emit (FileErrors_l.IsADirectory name) ~loc
else None
in
let rec rec_find_file = function
| [] -> FileErrors.emit (FileErrors_l.FileNotFound name) ~loc
| dir :: dirs -> (
match get_name (Filename.concat dir name) with
| Some f -> f
| None -> rec_find_file dirs)
in
if check_dirs then rec_find_file dirs else
match get_name name with
| Some f -> f
| None -> FileErrors.emit (FileErrors_l.FileNotFound name) ~loc
let ( >> ) f g x = f (g x)
let decompose ~input ~base =
let rec decompose_aux i b res =
let q = i / b in
let r = i mod b in
match q with 0 -> r :: res | _ -> decompose_aux q base (r :: res)
in
decompose_aux input base []
module type MapToSet = functor (_ : Set.S) -> Map.S