|
1
|
(*
|
|
2
|
* Copyright (c) 2009 CNRS & Université Bordeaux 1.
|
|
3
|
*
|
|
4
|
* Author(s): Grégoire Sutre <gregoire.sutre@labri.fr>,
|
|
5
|
* modified by Julien Forget <julien.forget@lifl.fr>
|
|
6
|
*
|
|
7
|
* Permission to use, copy, modify, and distribute this software for any
|
|
8
|
* purpose with or without fee is hereby granted, provided that the above
|
|
9
|
* copyright notice and this permission notice appear in all copies.
|
|
10
|
*
|
|
11
|
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
|
12
|
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
|
13
|
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
|
14
|
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
|
15
|
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
|
16
|
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
|
17
|
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
|
18
|
*)
|
|
19
|
|
|
20
|
|
|
21
|
(*
|
|
22
|
* Signatures and helper functions for pretty-printing.
|
|
23
|
*)
|
|
24
|
|
|
25
|
|
|
26
|
module type PRINTABLE_TYPE =
|
|
27
|
sig
|
|
28
|
type t
|
|
29
|
val print : Format.formatter -> t -> unit
|
|
30
|
end
|
|
31
|
|
|
32
|
|
|
33
|
let string_converter_from_printer printer =
|
|
34
|
function data ->
|
|
35
|
Format.fprintf Format.str_formatter "@[%a@]" printer data ;
|
|
36
|
Format.flush_str_formatter ()
|
|
37
|
|
|
38
|
let hashtbl_printer_from_printer beg_f sep_f end_f printer fmt hashtbl =
|
|
39
|
let length = Hashtbl.length hashtbl in
|
|
40
|
if length > 0 then
|
|
41
|
begin
|
|
42
|
Format.fprintf fmt beg_f;
|
|
43
|
ignore(
|
|
44
|
Hashtbl.fold
|
|
45
|
(fun k v cpt ->
|
|
46
|
if cpt < length then
|
|
47
|
begin
|
|
48
|
Format.fprintf fmt "@[%a@]" printer (k,v);
|
|
49
|
Format.fprintf fmt sep_f;
|
|
50
|
cpt+1
|
|
51
|
end
|
|
52
|
else
|
|
53
|
begin
|
|
54
|
Format.fprintf fmt "@[%a@]" printer (k,v);
|
|
55
|
Format.fprintf fmt end_f;
|
|
56
|
cpt+1
|
|
57
|
end)
|
|
58
|
hashtbl 1)
|
|
59
|
end
|
|
60
|
|
|
61
|
let list_printer_from_printer beg_f sep_f end_f printer fmt list =
|
|
62
|
match list with
|
|
63
|
[] -> ()
|
|
64
|
| head::tail ->
|
|
65
|
Format.fprintf fmt beg_f;
|
|
66
|
Format.fprintf fmt "@[%a@]" printer head;
|
|
67
|
List.iter
|
|
68
|
(function data ->
|
|
69
|
begin
|
|
70
|
Format.fprintf fmt sep_f;
|
|
71
|
Format.fprintf fmt "@[%a@]" printer data
|
|
72
|
end)
|
|
73
|
tail;
|
|
74
|
Format.fprintf fmt end_f
|
|
75
|
|
|
76
|
let array_printer_from_printer beg_f sep_f end_f printer fmt array =
|
|
77
|
if (Array.length array) > 0 then
|
|
78
|
let n = Array.length array
|
|
79
|
in
|
|
80
|
Format.fprintf fmt beg_f;
|
|
81
|
for i = 0 to n - 2 do
|
|
82
|
Format.fprintf fmt "@[%a@]" printer (i, array.(i)) ;
|
|
83
|
Format.fprintf fmt sep_f
|
|
84
|
done ;
|
|
85
|
Format.fprintf fmt "@[%a@]" printer (n-1, array.(n-1));
|
|
86
|
Format.fprintf fmt end_f
|
|
87
|
|
|
88
|
(* Local Variables: *)
|
|
89
|
(* compile-command:"make -C .." *)
|
|
90
|
(* End: *)
|