small printer things.
This commit is contained in:
parent
c549b150e8
commit
d46c2e651c
|
@ -59,10 +59,10 @@ let rec print_params ff l =
|
||||||
and print_node_params ff l =
|
and print_node_params ff l =
|
||||||
fprintf ff "@[<2>%a@]" (print_list_r print_param "<<"","">>") 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
|
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
|
fprintf ff "@[<2>%a@]" (print_list_r print_vd "("","")") l
|
||||||
|
|
||||||
and print_index ff idx =
|
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
|
| Efby (None, e) -> fprintf ff "pre %a" print_exp e
|
||||||
| Ecall (op, args, reset) ->
|
| Ecall (op, args, reset) ->
|
||||||
fprintf ff "@[<2>%a@,%a%a@]"
|
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) ->
|
| Ewhen (e, c, n) ->
|
||||||
fprintf ff "@[<2>(%a@ when %a(%a))@]"
|
fprintf ff "@[<2>(%a@ when %a(%a))@]"
|
||||||
print_exp e print_longname c print_ident n
|
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@]"
|
fprintf ff "@[<2>merge %a@ %a@]"
|
||||||
print_ident x print_tag_e_list tag_e_list
|
print_ident x print_tag_e_list tag_e_list
|
||||||
| Etuple 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) ->
|
| Efield (e, field) ->
|
||||||
fprintf ff "%a.%a" print_exp e print_longname field
|
fprintf ff "%a.%a" print_exp e print_longname field
|
||||||
| Estruct f_e_list ->
|
| 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 ->
|
| Earray e_list ->
|
||||||
fprintf ff "@[<2>%a@]" (print_list_r print_exp "["";""]") e_list
|
fprintf ff "@[<2>%a@]" (print_list_r print_exp "["";""]") e_list
|
||||||
| Earray_op(array_op) -> print_array_op ff array_op
|
| Earray_op(array_op) -> print_array_op ff array_op
|
||||||
| Efield_update (f, e1, e2) ->
|
| Efield_update (f, e1, e2) ->
|
||||||
fprintf ff "@[<2>(%a with .%a =@ %a)@]"
|
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
|
and print_array_op ff = function
|
||||||
| Erepeat (n, e) -> fprintf ff "%a^%a" print_exp e print_size_exp n
|
| 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 (idx, e) -> fprintf ff "%a%a" print_exp e print_index idx
|
||||||
| Eselect_dyn (idx, _, e1, e2) ->
|
| Eselect_dyn (idx, _, e1, e2) ->
|
||||||
fprintf ff "%a%a default %a"
|
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) ->
|
| Eupdate (idx, e1, e2) ->
|
||||||
fprintf ff "@[<2>(%a with %a =@ %a)@]"
|
fprintf ff "@[<2>(%a with %a =@ %a)@]"
|
||||||
print_exp e1 print_index idx print_exp e2
|
print_exp e1 print_index idx print_exp e2
|
||||||
| Eselect_slice (idx1, idx2, e) ->
|
| Eselect_slice (idx1, idx2, e) ->
|
||||||
fprintf ff "%a[%a..%a]"
|
fprintf ff "%a[%a..%a]"
|
||||||
print_exp e print_size_exp idx1 print_size_exp idx2
|
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
|
| Econcat (e1, e2) -> fprintf ff "@[<2>%a@ @@ %a@]" print_exp e1 print_exp e2
|
||||||
| Eiterator (it, f, n, e_list, r) ->
|
| 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)
|
(iterator_to_string it)
|
||||||
print_op f
|
print_op f
|
||||||
print_size_exp n
|
print_size_exp n
|
||||||
(print_list_l print_exp "("","")") e_list
|
print_exp_tuple e_list
|
||||||
print_every r
|
print_every r
|
||||||
|
|
||||||
and print_tag_e_list ff tag_e_list =
|
and print_tag_e_list ff tag_e_list =
|
||||||
fprintf ff "@[%a@]"
|
fprintf ff "@[%a@]"
|
||||||
(print_list
|
(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 } =
|
let print_eq ff { eq_lhs = p; eq_rhs = e } =
|
||||||
if !Misc.full_type_info
|
if !Misc.full_type_info
|
||||||
then fprintf ff "@[<2>%a :: %a =@ %a@]"
|
then fprintf ff "@[<2>%a :: %a =@ %a@]"
|
||||||
print_pat p print_ck e.e_ck 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
|
else fprintf ff "@[<2>%a =@ %a@]" print_pat p print_exp e
|
||||||
|
|
||||||
|
|
||||||
let print_eqs ff = function
|
let print_eqs ff = function
|
||||||
|
@ -168,7 +168,7 @@ and print_type_desc ff = function
|
||||||
(print_record print_field) f_ty_list
|
(print_record print_field) f_ty_list
|
||||||
|
|
||||||
and print_field ff field =
|
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
|
let print_contract ff
|
||||||
{ c_local = l; c_eq = eqs;
|
{ c_local = l; c_eq = eqs;
|
||||||
|
@ -178,7 +178,7 @@ let print_contract ff
|
||||||
print_eqs eqs
|
print_eqs eqs
|
||||||
print_exp e_a
|
print_exp e_a
|
||||||
print_exp e_g
|
print_exp e_g
|
||||||
print_node_args cl
|
print_vd_tuple cl
|
||||||
|
|
||||||
|
|
||||||
let print_node ff
|
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@."
|
fprintf ff "@[node %s%a%a@ returns %a@]@\n%a%a%a@]@\n@."
|
||||||
n
|
n
|
||||||
print_node_params params
|
print_node_params params
|
||||||
print_node_args ni
|
print_vd_tuple ni
|
||||||
print_node_args no
|
print_vd_tuple no
|
||||||
(print_opt print_contract) contract
|
(print_opt print_contract) contract
|
||||||
print_local_vars nl
|
print_local_vars nl
|
||||||
print_eqs ne
|
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 print oc { p_opened = pm; p_types = pt; p_nodes = pn } =
|
||||||
let ff = formatter_of_out_channel oc
|
let ff = formatter_of_out_channel oc
|
||||||
in
|
in (
|
||||||
(List.iter (print_open_module ff) pm;
|
List.iter (print_open_module ff) pm;
|
||||||
List.iter (print_type_def ff) pt;
|
List.iter (print_type_def ff) pt;
|
||||||
List.iter (print_node ff) pn;
|
List.iter (print_node ff) pn;
|
||||||
fprintf ff "@?")
|
fprintf ff "@?" )
|
||||||
|
|
|
@ -5,13 +5,18 @@
|
||||||
(* Organization : LRI, University of Paris-Sud, Orsay *)
|
(* Organization : LRI, University of Paris-Sud, Orsay *)
|
||||||
(* *)
|
(* *)
|
||||||
(**************************************************************************)
|
(**************************************************************************)
|
||||||
(* useful stuff for printing *)
|
(** Useful stuff for printing *)
|
||||||
(* $Id: pp_tools.ml,v 1.12.4.1 2009-07-12 09:40:19 gerard Exp $ *)
|
|
||||||
|
|
||||||
open Format
|
open Format
|
||||||
|
|
||||||
(** print the list x1...xn : \@\[[lp][x1][sep][x2]...[sep][xn][rp]\]\@
|
(** {2 list couple and option generic functions} *)
|
||||||
and nothing if the list is empty *)
|
(** 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
|
let rec print_list print lp sep rp ff = function
|
||||||
| [] -> ()
|
| [] -> ()
|
||||||
| x::l ->
|
| 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;
|
List.iter (fprintf ff "%s@,%a" sep print) l;
|
||||||
fprintf ff "%s" rp
|
fprintf ff "%s" rp
|
||||||
|
|
||||||
(** print the list x1...xn : \@\[[lp][x1][sep] [x2]...[sep] [xn][rp]\]\@
|
(** Prints the list [x1...xn] : [lp x1 sep \@ x2 ... sep \@ xn rp]
|
||||||
and nothing if the list is empty *)
|
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
|
let rec print_list_r print lp sep rp ff = function
|
||||||
| [] -> ()
|
| [] -> ()
|
||||||
| x :: l ->
|
| 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;
|
List.iter (fprintf ff "%s@ %a" sep print) l;
|
||||||
fprintf ff "%s" rp
|
fprintf ff "%s" rp
|
||||||
|
|
||||||
(** print the list x1...xn : \@\[[lp][x1] [sep][x2]... [sep][xn][rp]\]\@
|
(** Print the list [x1...xn] : [lp x1 \@ sep x2 ... \@ sep xn rp]
|
||||||
and nothing if the list is empty *)
|
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
|
let rec print_list_l print lp sep rp ff = function
|
||||||
| [] -> ()
|
| [] -> ()
|
||||||
| x :: l ->
|
| x :: l ->
|
||||||
fprintf ff "%s%a" lp print x;
|
fprintf ff "%s%a" lp print x;
|
||||||
List.iter (fprintf ff "@ %s%a" sep print) l;
|
List.iter (fprintf ff "@ %s%a" sep print) l;
|
||||||
fprintf ff "%s" rp
|
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
|
(** Print the couple [(c1,c2)] as [lp c1 sep \@, c2 rp]
|
||||||
| [] -> ()
|
no space is added, but a break right after [sep]. *)
|
||||||
| x :: l ->
|
|
||||||
fprintf ff "@[<2>%s%a@]" lp print x;
|
|
||||||
List.iter (fprintf ff "@]@ @[<2>%s%a" sep print) l;
|
|
||||||
fprintf ff "%s@]" rp
|
|
||||||
*)
|
|
||||||
let print_couple print1 print2 lp sep rp ff (c1, c2) =
|
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
|
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
|
|
||||||
|
|
||||||
|
(** Print something only in the case of [Some] *)
|
||||||
let print_opt print ff = function
|
let print_opt print ff = function
|
||||||
| None -> ()
|
| None -> ()
|
||||||
| Some(s) -> print ff s
|
| Some(s) -> print ff s
|
||||||
|
|
||||||
let print_opt_magic print ff = function
|
(** Print [sep][s] only when [Some(s)]. *)
|
||||||
| None -> pp_print_string ff "Obj.magic ()"
|
|
||||||
| Some(e) -> print ff e
|
|
||||||
|
|
||||||
|
|
||||||
let print_opt2 print sep ff = function
|
let print_opt2 print sep ff = function
|
||||||
| None -> ()
|
| None -> ()
|
||||||
| Some(s) -> fprintf ff "%s%a" sep print s
|
| Some(s) -> fprintf ff "%s%a" sep print s
|
||||||
|
|
||||||
let print_record print ff r =
|
(** {2 Common and usual syntax} *)
|
||||||
fprintf ff "@[<hv2>%a@]" (print_list_r print "{ "";"" }") r
|
(** 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 =
|
let print_type_params ff pl =
|
||||||
print_list_r (fun ff s -> fprintf ff "'%s" s) "("","") " ff pl
|
print_list_r (fun ff s -> fprintf ff "'%s" s) "("","") " ff pl
|
||||||
|
|
Loading…
Reference in a new issue