jeltz/heptagon
1
0
Fork 0
Code Issues Pull requests Releases Activity

Fix global_printer to follow Format conventions.

Browse source
This commit is contained in:
Léonard Gérard 2011-05-18 09:36:41 +02:00
parent b786cbe4ec
commit efcb2b01bb
1 changed files with 18 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
compiler/global/global_printer.ml
View file

@ -116,7 +116,7 @@ let print_size_constraint ff = function
let print_param ff p =
fprintf ff "%a:%a" Names.print_name p.p_name print_type p.p_type
let print_interface_type ff name tdesc =
let print_interface_type ff (name,tdesc) =
match tdesc with
| Tabstract -> fprintf ff "@[type %s@]" name
| Tenum tag_name_list ->
@ -127,42 +127,41 @@ let print_interface_type ff name tdesc =
fprintf ff "@[<2>type %s =@ %a@]" name print_struct f_ty_list
| Talias t -> fprintf ff "@[<2>type %s = %a@]" name print_type t
let print_interface_const ff name c =
let print_interface_const ff (name,c) =
fprintf ff "@[<2>const %a : %a = %a@]@."
print_name name
print_type c.Signature.c_type
print_static_exp c.Signature.c_value
let print_interface_value ff name node =
let print_arg ff arg = match arg.a_name with
| None ->
fprintf ff "@[%a :: %a@]" print_type arg.a_type print_sck arg.a_clock
| Some(name) ->
fprintf ff "@[%a : %a :: %a@]"
print_name name
print_type arg.a_type
print_sck arg.a_clock
in
let print_sarg ff arg = match arg.a_name with
| None ->
fprintf ff "@[%a :: %a@]" print_type arg.a_type print_sck arg.a_clock
| Some(name) ->
fprintf ff "@[%a : %a :: %a@]"
print_name name
print_type arg.a_type
print_sck arg.a_clock
let print_interface_value ff (name,node) =
let print_node_params ff p_list =
print_list_r (fun ff p -> print_name ff p.p_name) "<<" "," ">>" ff p_list
in
fprintf ff "@[<v 2>val %a%a@[%a@] returns @[%a@]@,@[%a@]@]"
print_name name
print_node_params node.node_params
(print_list_r print_arg "(" ";" ")") node.node_inputs
(print_list_r print_arg "(" ";" ")") node.node_outputs
(print_list_r print_size_constraint " with: " "," "")
node.node_params_constraints
(print_list_r print_sarg "(" ";" ")") node.node_inputs
(print_list_r print_sarg "(" ";" ")") node.node_outputs
(print_list_r print_size_constraint " with: " "," "") node.node_params_constraints
let print_interface ff =
let m = Modules.current_module () in
NamesEnv.iter
(fun key typdesc -> print_interface_type ff key typdesc) m.m_types;
(fun key typdesc -> print_interface_type ff (key,typdesc)) m.m_types;
NamesEnv.iter
(fun key constdec -> print_interface_const ff key constdec) m.m_consts;
(fun key constdec -> print_interface_const ff (key,constdec)) m.m_consts;
NamesEnv.iter
(fun key sigtype -> print_interface_value ff key sigtype) m.m_values;
(fun key sigtype -> print_interface_value ff (key,sigtype)) m.m_values;
Format.fprintf ff "@."