Revision b1655a21 src/printers.ml
| src/printers.ml | ||
|---|---|---|
| 9 | 9 |
(* *) |
| 10 | 10 |
(********************************************************************) |
| 11 | 11 |
|
| 12 |
open Corelang |
|
| 13 | 12 |
open LustreSpec |
| 14 | 13 |
open Format |
| 15 | 14 |
open Utils |
| ... | ... | |
| 192 | 191 |
pp_eq_lhs eq.eq_lhs |
| 193 | 192 |
pp_expr eq.eq_rhs |
| 194 | 193 |
|
| 195 |
let pp_node_eqs = fprintf_list ~sep:"@ " pp_node_eq
|
|
| 194 |
let pp_node_eqs = fprintf_list ~sep:"@ " pp_node_eq |
|
| 196 | 195 |
|
| 196 |
let rec pp_var_struct_type_field fmt (label, tdesc) = |
|
| 197 |
fprintf fmt "%a : %a;" pp_print_string label pp_var_type_dec_desc tdesc |
|
| 198 |
and pp_var_type_dec_desc fmt tdesc = |
|
| 199 |
match tdesc with |
|
| 200 |
| Tydec_any -> fprintf fmt "<any>" |
|
| 201 |
| Tydec_int -> fprintf fmt "int" |
|
| 202 |
| Tydec_real -> fprintf fmt "real" |
|
| 203 |
| Tydec_float -> fprintf fmt "float" |
|
| 204 |
| Tydec_bool -> fprintf fmt "bool" |
|
| 205 |
| Tydec_clock t -> fprintf fmt "%a clock" pp_var_type_dec_desc t |
|
| 206 |
| Tydec_const t -> fprintf fmt "%s" t |
|
| 207 |
| Tydec_enum id_list -> fprintf fmt "enum {%a }" (fprintf_list ~sep:", " pp_print_string) id_list
|
|
| 208 |
| Tydec_struct f_list -> fprintf fmt "struct {%a }" (fprintf_list ~sep:" " pp_var_struct_type_field) f_list
|
|
| 209 |
| Tydec_array (s, t) -> fprintf fmt "%a^%a" pp_var_type_dec_desc t Dimension.pp_dimension s |
|
| 197 | 210 |
|
| 198 | 211 |
let pp_var_type_dec fmt ty = |
| 199 |
let rec pp_var_struct_type_field fmt (label, tdesc) = |
|
| 200 |
fprintf fmt "%a : %a" pp_var_type_dec_desc tdesc pp_print_string label |
|
| 201 |
and pp_var_type_dec_desc fmt tdesc = |
|
| 202 |
match tdesc with |
|
| 203 |
| Tydec_any -> fprintf fmt "<any>" |
|
| 204 |
| Tydec_int -> fprintf fmt "int" |
|
| 205 |
| Tydec_real -> fprintf fmt "real" |
|
| 206 |
| Tydec_float -> fprintf fmt "float" |
|
| 207 |
| Tydec_bool -> fprintf fmt "bool" |
|
| 208 |
| Tydec_clock t -> fprintf fmt "%a clock" pp_var_type_dec_desc t |
|
| 209 |
| Tydec_const t -> fprintf fmt "%s" t |
|
| 210 |
| Tydec_enum id_list -> fprintf fmt "enum {%a }" (fprintf_list ~sep:", " pp_print_string) id_list
|
|
| 211 |
| Tydec_struct f_list -> fprintf fmt "struct {%a }" (fprintf_list ~sep:"; " pp_var_struct_type_field) f_list
|
|
| 212 |
| Tydec_array (s, t) -> fprintf fmt "%a^%a" pp_var_type_dec_desc t Dimension.pp_dimension s |
|
| 213 |
in pp_var_type_dec_desc fmt ty.ty_dec_desc |
|
| 212 |
pp_var_type_dec_desc fmt ty.ty_dec_desc |
|
| 213 |
|
|
| 214 |
let pp_type_def fmt ty = |
|
| 215 |
fprintf fmt "type %s = %a;@ " ty.ty_def_id pp_var_type_dec_desc ty.ty_def_desc |
|
| 214 | 216 |
|
| 215 | 217 |
(* let rec pp_var_type fmt ty = *) |
| 216 | 218 |
(* fprintf fmt "%a" (match ty.tdesc with *) |
| ... | ... | |
| 295 | 297 |
| ImportedNode ind -> |
| 296 | 298 |
fprintf fmt "imported %a;@ " pp_imported_node ind |
| 297 | 299 |
| Consts clist -> (fprintf fmt "const %a@ " pp_const_list clist) |
| 298 |
| Open (local, s) -> if local then fprintf fmt "open \"%s\"" s else fprintf fmt "open <%s>" s
|
|
| 299 |
|
|
| 300 |
| Open (local, s) -> if local then fprintf fmt "open \"%s\"@ " s else fprintf fmt "open <%s>@ " s
|
|
| 301 |
| Type tdef -> fprintf fmt "%a@ " pp_type_def tdef |
|
| 300 | 302 |
|
| 301 | 303 |
let pp_prog fmt prog = |
| 302 | 304 |
fprintf_list ~sep:"@ " pp_decl fmt prog |
| ... | ... | |
| 306 | 308 |
| Node nd -> fprintf fmt "node %s@ " nd.node_id |
| 307 | 309 |
| ImportedNode ind -> fprintf fmt "imported node %s" ind.nodei_id |
| 308 | 310 |
| Consts clist -> (fprintf fmt "const %a@ " pp_const_list clist) |
| 309 |
| Open (local, s) -> if local then fprintf fmt "open \"%s\"" s else fprintf fmt "open <%s>" s |
|
| 311 |
| Open (local, s) -> if local then fprintf fmt "open \"%s\"@ " s else fprintf fmt "open <%s>@ " s |
|
| 312 |
| Type tdef -> fprintf fmt "type %s;@ " tdef.ty_def_id |
|
| 310 | 313 |
|
| 311 | 314 |
let pp_lusi fmt decl = |
| 312 | 315 |
match decl.top_decl_desc with |
| ... | ... | |
| 318 | 321 |
pp_node_args nd.node_inputs |
| 319 | 322 |
pp_node_args nd.node_outputs |
| 320 | 323 |
| Consts clist -> (fprintf fmt "const %a@ " pp_const_list clist) |
| 321 |
| ImportedNode _ | Open _ -> () |
|
| 322 |
|
|
| 323 |
|
|
| 324 |
|
|
| 324 |
| Open (local, s) -> if local then fprintf fmt "open \"%s\"@ " s else fprintf fmt "open <%s>@ " s |
|
| 325 |
| Type tdef -> fprintf fmt "%a@ " pp_type_def tdef |
|
| 326 |
| ImportedNode _ -> () |
|
| 325 | 327 |
|
| 326 | 328 |
let pp_lusi_header fmt filename prog = |
| 327 | 329 |
fprintf fmt "(* Generated Lustre Interface file from %s *)@." filename; |
| 328 |
fprintf fmt "(* generated by Lustre-C compiler version %s, %a *)@." Version.number pp_date (Unix.gmtime (Unix.time ()));
|
|
| 329 |
fprintf fmt "(* feel free to mask some of the nodes by removing them from this file. *)@.@.";
|
|
| 330 |
fprintf fmt "(* by Lustre-C compiler version %s, %a *)@." Version.number pp_date (Unix.gmtime (Unix.time ())); |
|
| 331 |
fprintf fmt "(* Feel free to mask some of the definitions by removing them from this file. *)@.@.";
|
|
| 330 | 332 |
List.iter (fprintf fmt "%a@." pp_lusi) prog |
| 331 | 333 |
|
| 332 | 334 |
(* Local Variables: *) |
Also available in: Unified diff