2010-06-16 19:31:51 +02:00
|
|
|
(**************************************************************************)
|
|
|
|
(* *)
|
|
|
|
(* Lucid Synchrone V4 *)
|
|
|
|
(* Copyright (C) 2008 Marc Pouzet *)
|
|
|
|
(* Organization : LRI, University of Paris-Sud, Orsay *)
|
|
|
|
(* *)
|
|
|
|
(**************************************************************************)
|
2010-06-21 01:45:23 +02:00
|
|
|
(** Useful stuff for printing *)
|
|
|
|
|
2010-06-16 19:31:51 +02:00
|
|
|
|
|
|
|
open Format
|
|
|
|
|
2010-06-17 16:09:32 +02:00
|
|
|
let rec print_list print lp sep rp ff = function
|
2010-06-16 19:31:51 +02:00
|
|
|
| [] -> ()
|
|
|
|
| x::l ->
|
2010-06-26 16:53:25 +02:00
|
|
|
fprintf ff "%s%a" lp print x;
|
|
|
|
List.iter (fprintf ff "%s@,%a" sep print) l;
|
|
|
|
fprintf ff "%s" rp
|
2010-06-16 19:31:51 +02:00
|
|
|
|
2010-06-21 18:19:58 +02:00
|
|
|
|
2010-06-16 19:31:51 +02:00
|
|
|
let rec print_list_r print lp sep rp ff = function
|
|
|
|
| [] -> ()
|
|
|
|
| x :: l ->
|
2010-06-19 18:28:52 +02:00
|
|
|
fprintf ff "%s%a" lp print x;
|
|
|
|
List.iter (fprintf ff "%s@ %a" sep print) l;
|
2010-06-26 16:53:25 +02:00
|
|
|
fprintf ff "%s" rp
|
2010-06-16 19:31:51 +02:00
|
|
|
|
2010-06-21 18:19:58 +02:00
|
|
|
|
2010-06-16 19:31:51 +02:00
|
|
|
let rec print_list_l print lp sep rp ff = function
|
|
|
|
| [] -> ()
|
|
|
|
| x :: l ->
|
2010-06-19 18:28:52 +02:00
|
|
|
fprintf ff "%s%a" lp print x;
|
|
|
|
List.iter (fprintf ff "@ %s%a" sep print) l;
|
2010-06-26 16:53:25 +02:00
|
|
|
fprintf ff "%s" rp
|
2010-06-16 19:31:51 +02:00
|
|
|
|
2010-06-21 18:19:58 +02:00
|
|
|
|
2010-06-16 19:31:51 +02:00
|
|
|
let print_couple print1 print2 lp sep rp ff (c1, c2) =
|
2010-06-26 16:53:25 +02:00
|
|
|
fprintf ff "%s%a%s@,%a%s" lp print1 c1 sep print2 c2 rp
|
2010-06-16 19:31:51 +02:00
|
|
|
|
2010-06-21 18:19:58 +02:00
|
|
|
|
2010-06-16 19:31:51 +02:00
|
|
|
let print_opt print ff = function
|
|
|
|
| None -> ()
|
|
|
|
| Some(s) -> print ff s
|
|
|
|
|
2010-06-21 18:19:58 +02:00
|
|
|
|
2010-06-16 19:31:51 +02:00
|
|
|
let print_opt2 print sep ff = function
|
|
|
|
| None -> ()
|
|
|
|
| Some(s) -> fprintf ff "%s%a" sep print s
|
|
|
|
|
2010-06-21 01:45:23 +02:00
|
|
|
|
|
|
|
let print_record print_field ff record =
|
|
|
|
fprintf ff "@[<hv2>%a@]" (print_list_r print_field "{ "";"" }") record
|
|
|
|
|
2010-06-16 19:31:51 +02:00
|
|
|
|
|
|
|
let print_type_params ff pl =
|
2010-09-10 14:06:19 +02:00
|
|
|
fprintf ff "@[%a@]"
|
|
|
|
(print_list_r (fun ff s -> fprintf ff "'%s" s) "("","") ") pl
|
2010-06-16 19:31:51 +02:00
|
|
|
|
|
|
|
|
2010-09-09 00:35:06 +02:00
|
|
|
let print_set iter print_element ff set =
|
2010-08-17 15:04:16 +02:00
|
|
|
fprintf ff "@[{@ ";
|
|
|
|
iter (fun e -> fprintf ff "%a@ " print_element e) set;
|
|
|
|
fprintf ff "}@]"
|
|
|
|
|
2010-09-09 00:35:06 +02:00
|
|
|
let print_map iter print_key print_element ff map =
|
|
|
|
fprintf ff "@[<hv 2>[@ ";
|
|
|
|
iter (fun k x -> fprintf ff "| %a -> %a@ " print_key k print_element x) map;
|
2010-08-17 15:04:16 +02:00
|
|
|
fprintf ff "]@]"
|
2011-04-20 14:05:55 +02:00
|
|
|
|
|
|
|
|