Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / Print.ml @ 22fe1c93

History | View | Annotate | Download (2.69 KB)

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: *)