From d46c2e651c5fb9d321c2a15a68760735888b4848 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9onard=20G=C3=A9rard?= Date: Mon, 21 Jun 2010 01:45:23 +0200 Subject: [PATCH] small printer things. --- minils/minils_printer.ml | 46 ++++++++++++++--------------- utilities/pp_tools.ml | 63 +++++++++++++++++++--------------------- 2 files changed, 53 insertions(+), 56 deletions(-) diff --git a/minils/minils_printer.ml b/minils/minils_printer.ml index 8b90a86..3237372 100644 --- a/minils/minils_printer.ml +++ b/minils/minils_printer.ml @@ -59,10 +59,10 @@ let rec print_params ff l = and print_node_params ff l = fprintf ff "@[<2>%a@]" (print_list_r print_param "<<"","">>") l -and print_args ff l = +and print_exp_tuple ff l = fprintf ff "@[<2>%a@]" (print_list_r print_exp "("","")") l -and print_node_args ff l = +and print_vd_tuple ff l = fprintf ff "@[<2>%a@]" (print_list_r print_vd "("","")") l and print_index ff idx = @@ -90,7 +90,7 @@ and print_exp_desc ff = function | Efby (None, e) -> fprintf ff "pre %a" print_exp e | Ecall (op, args, reset) -> fprintf ff "@[<2>%a@,%a%a@]" - print_op op print_args args print_every reset + print_op op print_exp_tuple args print_every reset | Ewhen (e, c, n) -> fprintf ff "@[<2>(%a@ when %a(%a))@]" print_exp e print_longname c print_ident n @@ -101,51 +101,51 @@ and print_exp_desc ff = function fprintf ff "@[<2>merge %a@ %a@]" print_ident x print_tag_e_list tag_e_list | Etuple e_list -> - fprintf ff "@[<2>%a@]" (print_list_r print_exp "("","")") e_list + print_exp_tuple ff e_list | Efield (e, field) -> fprintf ff "%a.%a" print_exp e print_longname field | Estruct f_e_list -> - print_record (print_couple print_longname print_exp """ =""") ff f_e_list + print_record (print_couple print_longname print_exp """ = """) ff f_e_list | Earray e_list -> fprintf ff "@[<2>%a@]" (print_list_r print_exp "["";""]") e_list | Earray_op(array_op) -> print_array_op ff array_op | Efield_update (f, e1, e2) -> fprintf ff "@[<2>(%a with .%a =@ %a)@]" - print_exp e1 print_longname f print_exp e2 + print_exp e1 print_longname f print_exp e2 and print_array_op ff = function - | Erepeat (n, e) -> fprintf ff "%a^%a" print_exp e print_size_exp n - | Eselect (idx, e) -> fprintf ff "%a%a" print_exp e print_index idx + | Erepeat (n, e) -> fprintf ff "%a^%a" print_exp e print_size_exp n + | Eselect (idx, e) -> fprintf ff "%a%a" print_exp e print_index idx | Eselect_dyn (idx, _, e1, e2) -> fprintf ff "%a%a default %a" - print_exp e1 print_dyn_index idx print_exp e2 + print_exp e1 print_dyn_index idx print_exp e2 | Eupdate (idx, e1, e2) -> fprintf ff "@[<2>(%a with %a =@ %a)@]" print_exp e1 print_index idx print_exp e2 | Eselect_slice (idx1, idx2, e) -> fprintf ff "%a[%a..%a]" - print_exp e print_size_exp idx1 print_size_exp idx2 - | Econcat (e1, e2) -> fprintf ff "@[<2>%a@ @@ %a@]" print_exp e1 print_exp e2 + print_exp e print_size_exp idx1 print_size_exp idx2 + | Econcat (e1, e2) -> fprintf ff "@[<2>%a@ @@ %a@]" print_exp e1 print_exp e2 | Eiterator (it, f, n, e_list, r) -> - fprintf ff "@[<2>(%s (%a)<<%a>>)@ @[<2>%a@]@]%a" + fprintf ff "@[<2>(%s (%a)<<%a>>)@,%a@]%a" (iterator_to_string it) print_op f print_size_exp n - (print_list_l print_exp "("","")") e_list + print_exp_tuple e_list print_every r and print_tag_e_list ff tag_e_list = fprintf ff "@[%a@]" (print_list - (print_couple print_longname print_exp "("" ->"")") """""") tag_e_list + (print_couple print_longname print_exp "("" -> "")") """""") tag_e_list let print_eq ff { eq_lhs = p; eq_rhs = e } = if !Misc.full_type_info then fprintf ff "@[<2>%a :: %a =@ %a@]" - print_pat p print_ck e.e_ck print_exp e - else fprintf ff "@[<2>%a =@ %a@]" print_pat p print_exp e + print_pat p print_ck e.e_ck print_exp e + else fprintf ff "@[<2>%a =@ %a@]" print_pat p print_exp e let print_eqs ff = function @@ -168,7 +168,7 @@ and print_type_desc ff = function (print_record print_field) f_ty_list and print_field ff field = - fprintf ff "@[%a: %a@]" print_name field.f_name print_type field.f_type + fprintf ff "@[%a: %a@]" print_name field.f_name print_type field.f_type let print_contract ff { c_local = l; c_eq = eqs; @@ -178,7 +178,7 @@ let print_contract ff print_eqs eqs print_exp e_a print_exp e_g - print_node_args cl + print_vd_tuple cl let print_node ff @@ -187,8 +187,8 @@ let print_node ff fprintf ff "@[node %s%a%a@ returns %a@]@\n%a%a%a@]@\n@." n print_node_params params - print_node_args ni - print_node_args no + print_vd_tuple ni + print_vd_tuple no (print_opt print_contract) contract print_local_vars nl print_eqs ne @@ -206,8 +206,8 @@ let print_clock oc ct = let print oc { p_opened = pm; p_types = pt; p_nodes = pn } = let ff = formatter_of_out_channel oc - in - (List.iter (print_open_module ff) pm; + in ( + List.iter (print_open_module ff) pm; List.iter (print_type_def ff) pt; List.iter (print_node ff) pn; - fprintf ff "@?") + fprintf ff "@?" ) diff --git a/utilities/pp_tools.ml b/utilities/pp_tools.ml index 5bf0e68..442b88f 100644 --- a/utilities/pp_tools.ml +++ b/utilities/pp_tools.ml @@ -5,13 +5,18 @@ (* Organization : LRI, University of Paris-Sud, Orsay *) (* *) (**************************************************************************) -(* useful stuff for printing *) -(* $Id: pp_tools.ml,v 1.12.4.1 2009-07-12 09:40:19 gerard Exp $ *) +(** Useful stuff for printing *) + open Format -(** print the list x1...xn : \@\[[lp][x1][sep][x2]...[sep][xn][rp]\]\@ - and nothing if the list is empty *) +(** {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 -> @@ -19,8 +24,9 @@ let rec print_list print lp sep rp ff = function 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 *) +(** 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 -> @@ -28,50 +34,41 @@ let rec print_list_r print lp sep rp ff = function 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 *) +(** 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 -(* -let rec print_list_rb print lp sep rp ff = function - | [] -> () - | x :: l -> - fprintf ff "@[<2>%s%a" lp print x; - List.iter (fprintf ff "%s@]@ @[<2>%a" sep print) l; - fprintf ff "%s@]" rp -let rec print_list_lb print lp sep rp ff = function - | [] -> () - | x :: l -> - fprintf ff "@[<2>%s%a@]" lp print x; - List.iter (fprintf ff "@]@ @[<2>%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 - -let print_couple2 print1 print2 lp sep1 sep2 rp ff (c1, c2) = - fprintf ff "%s%a%s@ %s%a%s" lp print1 c1 sep1 sep2 print2 c2 rp + 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 -let print_opt_magic print ff = function - | None -> pp_print_string ff "Obj.magic ()" - | Some(e) -> print ff e - - +(** Print [sep][s] only when [Some(s)]. *) let print_opt2 print sep ff = function | None -> () | Some(s) -> fprintf ff "%s%a" sep print s -let print_record print ff r = - fprintf ff "@[%a@]" (print_list_r print "{ "";"" }") r +(** {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 "@[%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