1 module LexingExt = struct
9 pos_lnum = lexbuf.lex_curr_p.pos_lnum + 1
14 if s.[i] >= '0' && s.[i] <= '9' then
23 Some (pos, pos', int_of_string (String.sub s pos (pos' - pos)))
27 module ListExt = struct
29 let inv_assoc l = List.map (fun (x, y) -> (y, x)) l
33 let last l = try List.hd (List.rev l) with _ -> raise EmptyList
36 let rec aux l = function
37 | [] -> raise EmptyList
38 | [ x ] -> (x, List.rev l)
39 | x :: xs -> aux (x :: l) xs
43 let multi_set_of_list l =
44 let h = Hashtbl.create 13 in
46 let o = try Hashtbl.find h x with Not_found -> 0 in
47 Hashtbl.replace h x (o + 1)
50 Hashtbl.fold (fun k v accu -> (k, v) :: accu) h []
52 let hashtbl_of_assoc l =
53 let h = Hashtbl.create 13 in
54 List.iter (fun (k, v) -> Hashtbl.add h k v) l;
58 let assoc_union l1 l2 =
59 let h1 = hashtbl_of_assoc l1 in
64 let v2 = Hashtbl.find h1 k in
65 if v1 <> v2 then raise Conflict;
69 let assoc_diff l1 l2 =
70 let h1 = hashtbl_of_assoc l1 in
71 let h2 = hashtbl_of_assoc l2 in
76 try Some (Hashtbl.find h2 k)
77 with Not_found -> None
81 (k, (Some v1, v2)) :: accu
83 (k, (v2, Some v1)) :: accu
88 let d1 = diff h1 h2 true in
89 let d2 = diff h2 h1 false in
91 with Conflict -> assert false
93 let transitive_forall2 p l =
94 let rec aux = function
97 | x1 :: ((x2 :: _) as xs) ->
98 if not (p x1 x2) then Some (x1, x2) else aux xs
102 let repeat init n f =
103 let rec aux accu vs i =
104 if i = 0 then (accu, vs) else
105 let (accu, v) = f accu i in
106 aux accu (v :: vs) (pred i)
113 module ArgExt = struct
115 let extra_doc s = "", Arg.Unit ignore, s
119 module SysExt = struct
121 let safe_remove name =
122 try Sys.remove name with Sys_error _ -> ()
124 let rec alternative name =
126 match LexingExt.lex_num name 0 with
128 | Some (start, stop, num) ->
129 let len = String.length name in
130 Some (num, String.sub name (stop+1) (len - stop - 1))
132 if not (Sys.file_exists name) then
135 let dirname = Filename.dirname name in
136 let filename = Filename.basename name in
138 match split filename with
142 Printf.sprintf "%02d-%s" (i + 1) name
144 alternative (Filename.concat dirname filename)
148 module IOExt = struct
150 let stdout_buffer = Buffer.create 13
151 let stdout_formatter = Format.formatter_of_buffer stdout_buffer
152 let stderr_buffer = Buffer.create 13
153 let stderr_formatter = Format.formatter_of_buffer stderr_buffer
154 let enable_buffering = ref false
157 if !enable_buffering then
158 Format.fprintf stdout_formatter fmt
163 if !enable_buffering then
164 Format.fprintf stderr_formatter fmt
170 (Buffer.contents stdout_buffer, Buffer.contents stderr_buffer)
172 Buffer.clear stdout_buffer;
173 Buffer.clear stderr_buffer;
176 let set_buffered_mode () =
177 enable_buffering := true
181 module Timed = struct
183 let time now print_date f =
185 let start_date = now () in
187 let stop_date = now () in
188 print_date start_date stop_date;
191 let get_now = ref (fun () -> 0.)
193 let set_now now = get_now := now
195 let enable_profiling = ref false
197 let set_profiling_flag t = enable_profiling := t
199 let profile title f =
200 let print_date start stop =
201 IOExt.eprintf "[%05.0fms] %s\n" (stop -. start) title
203 if !enable_profiling then
204 time !get_now print_date f