108 lines
3.6 KiB
OCaml
108 lines
3.6 KiB
OCaml
(**************************************************************************)
|
|
(* *)
|
|
(* Lucid Synchrone V4 *)
|
|
(* Copyright (C) 2008 Marc Pouzet *)
|
|
(* Organization : LRI, University of Paris-Sud, Orsay *)
|
|
(* *)
|
|
(**************************************************************************)
|
|
(** Useful stuff for printing *)
|
|
|
|
|
|
open Format
|
|
|
|
(** {2 list couple and option generic functions} *)
|
|
(** Most of theses functions export breaks or breaking spaces
|
|
to the calling printer. *)
|
|
|
|
(** Print the list [x1...xn] as [lp x1 sep \@, x2 ... sep \@, xn rp]
|
|
and nothing if the list is empty,
|
|
no space is added, but a break right after every [sep]. *)
|
|
let rec print_list print lp sep rp ff = function
|
|
| [] -> ()
|
|
| x::l ->
|
|
fprintf ff "%s%a" lp print x;
|
|
List.iter (fprintf ff "%s@,%a" sep print) l;
|
|
fprintf ff "%s" rp
|
|
|
|
(** Prints the list [x1...xn] : [lp x1 sep \@ x2 ... sep \@ xn rp]
|
|
and nothing if the list is empty
|
|
a breaking space is added after every [sep]. *)
|
|
let rec print_list_r print lp sep rp ff = function
|
|
| [] -> ()
|
|
| x :: l ->
|
|
fprintf ff "%s%a" lp print x;
|
|
List.iter (fprintf ff "%s@ %a" sep print) l;
|
|
fprintf ff "%s" rp
|
|
|
|
(** Print the list [x1...xn] : [lp x1 \@ sep x2 ... \@ sep xn rp]
|
|
and nothing if the list is empty
|
|
a breaking space is added before every [sep]. *)
|
|
let rec print_list_l print lp sep rp ff = function
|
|
| [] -> ()
|
|
| x :: l ->
|
|
fprintf ff "%s%a" lp print x;
|
|
List.iter (fprintf ff "@ %s%a" sep print) l;
|
|
fprintf ff "%s" rp
|
|
|
|
(** Print the couple [(c1,c2)] as [lp c1 sep \@, c2 rp]
|
|
no space is added, but a break right after [sep]. *)
|
|
let print_couple print1 print2 lp sep rp ff (c1, c2) =
|
|
fprintf ff "%s%a%s@,%a%s" lp print1 c1 sep print2 c2 rp
|
|
|
|
(** Print something only in the case of [Some] *)
|
|
let print_opt print ff = function
|
|
| None -> ()
|
|
| Some(s) -> print ff s
|
|
|
|
(** Print [sep][s] only when [Some(s)]. *)
|
|
let print_opt2 print sep ff = function
|
|
| None -> ()
|
|
| Some(s) -> fprintf ff "%s%a" sep print s
|
|
|
|
(** {2 Common and usual syntax} *)
|
|
(** Theses functions are not exporting breaks
|
|
and they assume the same from the print functions passed as arguments *)
|
|
|
|
(** Print a record as [{field1;\@ field2;\@ ...}] with an hv<2> box
|
|
@param print_field is the print function for a field
|
|
@param record is the list of fields. *)
|
|
let print_record print_field ff record =
|
|
fprintf ff "@[<hv2>%a@]" (print_list_r print_field "{ "";"" }") record
|
|
|
|
|
|
let print_type_params ff pl =
|
|
print_list_r (fun ff s -> fprintf ff "'%s" s) "("","") " ff pl
|
|
|
|
|
|
(* Map and Set redefinition to allow pretty printing
|
|
|
|
module type P = sig
|
|
type t
|
|
val fprint : Format.formatter -> t -> unit
|
|
end
|
|
|
|
module type ELT = sig
|
|
type t
|
|
val compare : t -> t -> int
|
|
val fprint : Format.formatter -> t -> unit
|
|
end
|
|
|
|
module SetMake (Elt : ELT) = struct
|
|
module M = Set.Make(Elt)
|
|
include M
|
|
let fprint ff es =
|
|
Format.fprintf ff "@[<hov>{@ ";
|
|
iter (fun e -> Format.fprintf ff "%a@ " Elt.fprint e) es;
|
|
Format.fprintf ff "}@]";
|
|
end
|
|
|
|
module MapMake (Key : ELT) (Elt : P) = struct
|
|
module M = Map.Make(Key)
|
|
include M
|
|
let fprint prp eem =
|
|
Format.fprintf prp "[@[<hv 2>";
|
|
iter (fun k m -> Format.fprintf prp "@ | %a -> %a" Key.fprint k Elt.fprint m) eem;
|
|
Format.fprintf prp "@]@ ]";
|
|
end
|
|
*)
|