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
let get_extension s =
let rec aux s i =
if i <= 0 then ""
else
match s.[i] with
| '.' -> String.sub s i (String.length s - i)
| _ -> aux s (i - 1)
in
aux s (String.length s - 1)
let replicate n x =
let rec aux x acc i =
if i <= 0 then acc
else aux x (x :: acc) (i - 1)
in
aux x [] n
let split_on_char sep s =
let r = ref [] in
let j = ref (String.length s) in
for i = String.length s - 1 downto 0 do
if String.unsafe_get s i = sep then begin
r := String.sub s (i + 1) (!j - i - 1) :: !r;
j := i
end
done;
String.sub s 0 !j :: !r
let opt_map o f =
match o with
| None -> None
| Some x -> Some (f x)
let opt_bind o f =
match o with
| None -> None
| Some x -> f x
let pp_opt ?(none="<none>") pp b = function
| Some t -> pp b t
| None -> Printf.bprintf b "%s" none
let print_opt ?(none="<none>") print fmt = function
| Some t -> print fmt t
| None -> Format.fprintf fmt "%s" none
let rec pp_list ~pp_sep ~sep ~pp b = function
| [] -> ()
| [h] -> pp b h
| h :: r ->
Printf.bprintf b "%a%a%a"
pp h pp_sep sep
(pp_list ~pp_sep ~sep ~pp) r
let rec print_list ~print_sep ~sep ~print fmt = function
| [] -> ()
| [h] -> print fmt h
| h :: r ->
Format.fprintf fmt "%a%a%a"
print h print_sep sep
(print_list ~print_sep ~sep ~print) r
let set_file buf filename =
let open Lexing in
buf.lex_curr_p <- {buf.lex_curr_p with pos_fname=filename;};
()
let filename_of_input = function
| `Contents (file, _) -> file
| `File file -> file
| `Stdin -> "<stdin>"
let filename_of_input_source = function
| `Raw (file, _) -> file
| `File file -> file
| `Stdin -> "<stdin>"
let mk_lexbuf i =
let filename = filename_of_input i in
match i with
| `Contents (_, s) ->
let buf = Lexing.from_string s in
set_file buf filename;
buf, (fun () -> ())
| `Stdin ->
let ch, cl = stdin, (fun () -> ()) in
let buf = Lexing.from_channel ch in
set_file buf filename;
buf, cl
| `File s ->
let ch = open_in s in
let cl = (fun () -> close_in ch) in
let buf = Lexing.from_channel ch in
set_file buf filename;
buf, cl