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
|
(**************************************************************************)
(* *)
(* Copyright (C) Johannes Kanig, Stephane Lescuyer *)
(* Jean-Christophe Filliatre, Romain Bardou and Francois Bobot *)
(* *)
(* This software is free software; you can redistribute it and/or *)
(* modify it under the terms of the GNU Library General Public *)
(* License version 2.1, with the special exception on linking *)
(* described in file LICENSE. *)
(* *)
(* This software is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *)
(* *)
(**************************************************************************)
let write_to_file filename f =
let chan = open_out filename in
f chan;
close_out chan
let write_to_formatted_file filename f =
write_to_file filename
(fun chan ->
let fmt = Format.formatter_of_out_channel chan in
f fmt; Format.fprintf fmt "@?")
let print_option start printer fmt = function
| None -> ()
| Some o -> Format.fprintf fmt "%s%a " start printer o
let rec print_list sep prf fmt = function
| [] -> ()
| [x] -> prf fmt x
| (x::xs) -> prf fmt x; sep fmt (); print_list sep prf fmt xs
let space fmt () = Format.fprintf fmt "@ "
let comma fmt () = Format.fprintf fmt ",@ "
let semicolon fmt () = Format.fprintf fmt ";@ "
let newline fmt () = Format.fprintf fmt "@\n "
let rec fold_from_to f acc a b =
if a <= b then fold_from_to f (f acc a) (a+1) b else acc
let sprintf s =
let buf = Buffer.create 1024 in
let fmt = Format.formatter_of_buffer buf in
Format.kfprintf
(fun _ -> Format.pp_print_flush fmt (); Buffer.contents buf) fmt s
(*Filename.generic_quote*)
let generic_quote whatquote quotequote s =
let l = String.length s in
let b = Buffer.create (l + 20) in
for i = 0 to l - 1 do
if s.[i] = whatquote
then Buffer.add_string b quotequote
else Buffer.add_char b s.[i]
done;
Buffer.contents b
let generic_quote_list lwqq s =
let l = String.length s in
let b = Buffer.create (l + 20) in
for i = 0 to l - 1 do
if List.mem_assoc s.[i] lwqq
then Buffer.add_string b (List.assoc s.[i] lwqq)
else Buffer.add_char b s.[i]
done;
Buffer.contents b
let call_cmd ?(inv=false) ?(outv=false) ?(verbose=false) cmd =
(* inv = true -> print command line
* outv = true -> print command output
* verbose = true -> both
*)
if inv || verbose then Format.printf "+ %s@." cmd;
let inc = Unix.open_process_in cmd in
let buf = Buffer.create 16 in
(try
while true do
Buffer.add_channel buf inc 1
done
with End_of_file -> ());
let status = Unix.close_process_in inc in
let outp = Buffer.contents buf in
if outv || verbose then Format.printf "%s@?" outp;
(match status with | Unix.WEXITED n -> n | _ -> exit 1), outp
(* persistent queues *)
module Q = struct
type 'a t = 'a list * 'a list
exception Empty
let empty = [], []
let push x (i, o) = (x :: i, o)
let pop = function
| [], [] -> raise Empty
| (i, x :: o) -> x, (i, o)
| (i, []) -> match List.rev i with
| x :: o -> x, ([], o)
| [] -> assert false
let of_list l =
List.fold_left (fun q c -> push c q) empty l
end
|
