lustrec / src / printers.ml @ ef8a361a
History | View | Annotate | Download (14.8 KB)
1 | a2d97a3e | ploc | (********************************************************************) |
---|---|---|---|
2 | (* *) |
||
3 | (* The LustreC compiler toolset / The LustreC Development Team *) |
||
4 | (* Copyright 2012 - -- ONERA - CNRS - INPT *) |
||
5 | (* *) |
||
6 | (* LustreC is free software, distributed WITHOUT ANY WARRANTY *) |
||
7 | (* under the terms of the GNU Lesser General Public License *) |
||
8 | (* version 2.1. *) |
||
9 | (* *) |
||
10 | (********************************************************************) |
||
11 | |||
12 | 22fe1c93 | ploc | open LustreSpec |
13 | open Format |
||
14 | open Utils |
||
15 | |||
16 | (* Prints [v] as [pp_fun] would do, but adds a backslash at each end of line, |
||
17 | following the C convention for multiple lines macro *) |
||
18 | let pp_as_c_macro pp_fun fmt v = |
||
19 | 04a63d25 | xthirioux | let formatter_out_funs = pp_get_formatter_out_functions fmt () in |
20 | let macro_newline () = |
||
21 | begin |
||
22 | formatter_out_funs.out_string "\\" 0 1; |
||
23 | formatter_out_funs.out_newline () |
||
24 | end in |
||
25 | 22fe1c93 | ploc | begin |
26 | 04a63d25 | xthirioux | pp_set_formatter_out_functions fmt { formatter_out_funs with out_newline = macro_newline }; |
27 | 22fe1c93 | ploc | pp_fun fmt v; |
28 | 04a63d25 | xthirioux | pp_set_formatter_out_functions fmt formatter_out_funs; |
29 | 22fe1c93 | ploc | end |
30 | |||
31 | ec433d69 | xthirioux | let rec print_dec_struct_ty_field fmt (label, cty) = |
32 | fprintf fmt "%a : %a" pp_print_string label print_dec_ty cty |
||
33 | and print_dec_ty fmt cty = |
||
34 | match (*get_repr_type*) cty with |
||
35 | | Tydec_any -> fprintf fmt "Any" |
||
36 | | Tydec_int -> fprintf fmt "int" |
||
37 | 04a63d25 | xthirioux | | Tydec_real -> fprintf fmt "real" |
38 | ec433d69 | xthirioux | | Tydec_bool -> fprintf fmt "bool" |
39 | | Tydec_clock cty' -> fprintf fmt "%a clock" print_dec_ty cty' |
||
40 | | Tydec_const c -> fprintf fmt "%s" c |
||
41 | | Tydec_enum taglist -> fprintf fmt "enum {%a }" |
||
42 | (Utils.fprintf_list ~sep:", " pp_print_string) taglist |
||
43 | | Tydec_struct fieldlist -> fprintf fmt "struct {%a }" |
||
44 | (Utils.fprintf_list ~sep:"; " print_dec_struct_ty_field) fieldlist |
||
45 | | Tydec_array (d, cty') -> fprintf fmt "%a^%a" print_dec_ty cty' Dimension.pp_dimension d |
||
46 | 22fe1c93 | ploc | |
47 | let pp_var_name fmt id = fprintf fmt "%s" id.var_id |
||
48 | dd71e482 | ploc | let pp_var_type fmt id = Types.print_node_ty fmt id.var_type |
49 | 9f0f88dd | ploc | |
50 | 22fe1c93 | ploc | let pp_eq_lhs = fprintf_list ~sep:", " pp_print_string |
51 | |||
52 | af5af1e8 | ploc | let pp_var fmt id = fprintf fmt "%s%s: %a" (if id.var_dec_const then "const " else "") id.var_id Types.print_ty id.var_type |
53 | |||
54 | let pp_quantifiers fmt (q, vars) = |
||
55 | match q with |
||
56 | | Forall -> fprintf fmt "forall %a" (fprintf_list ~sep:"; " pp_var) vars |
||
57 | | Exists -> fprintf fmt "exists %a" (fprintf_list ~sep:"; " pp_var) vars |
||
58 | |||
59 | 12af4908 | xthirioux | let rec pp_struct_const_field fmt (label, c) = |
60 | fprintf fmt "%a = %a;" pp_print_string label pp_const c |
||
61 | and pp_const fmt c = |
||
62 | 22fe1c93 | ploc | match c with |
63 | | Const_int i -> pp_print_int fmt i |
||
64 | 04a63d25 | xthirioux | | Const_real (c, e, s) -> pp_print_string fmt s (*if e = 0 then pp_print_int fmt c else if e < 0 then Format.fprintf fmt "%ie%i" c (-e) else Format.fprintf fmt "%ie-%i" c e *) |
65 | (* | Const_float r -> pp_print_float fmt r *) |
||
66 | 22fe1c93 | ploc | | Const_tag t -> pp_print_string fmt t |
67 | | Const_array ca -> Format.fprintf fmt "[%a]" (Utils.fprintf_list ~sep:"," pp_const) ca |
||
68 | 12af4908 | xthirioux | | Const_struct fl -> Format.fprintf fmt "{%a }" (Utils.fprintf_list ~sep:" " pp_struct_const_field) fl |
69 | 01c7d5e1 | ploc | | Const_string s -> pp_print_string fmt ("\"" ^ s ^ "\"") |
70 | 22fe1c93 | ploc | |
71 | |||
72 | af5af1e8 | ploc | let rec pp_expr fmt expr = |
73 | (match expr.expr_annot with |
||
74 | | None -> fprintf fmt "%t" |
||
75 | 521e2a6b | ploc | | Some ann -> fprintf fmt "@[(%a %t)@]" pp_expr_annot ann) |
76 | af5af1e8 | ploc | (fun fmt -> |
77 | match expr.expr_desc with |
||
78 | 22fe1c93 | ploc | | Expr_const c -> pp_const fmt c |
79 | 521e2a6b | ploc | | Expr_ident id -> fprintf fmt "%s" id |
80 | 22fe1c93 | ploc | | Expr_array a -> fprintf fmt "[%a]" pp_tuple a |
81 | | Expr_access (a, d) -> fprintf fmt "%a[%a]" pp_expr a Dimension.pp_dimension d |
||
82 | | Expr_power (a, d) -> fprintf fmt "(%a^%a)" pp_expr a Dimension.pp_dimension d |
||
83 | | Expr_tuple el -> fprintf fmt "(%a)" pp_tuple el |
||
84 | 521e2a6b | ploc | | Expr_ite (c, t, e) -> fprintf fmt "@[<hov 1>(if %a then@ @[<hov 2>%a@]@ else@ @[<hov 2>%a@]@])" pp_expr c pp_expr t pp_expr e |
85 | e2380d4d | ploc | | Expr_arrow (e1, e2) -> fprintf fmt "(%a -> %a)" pp_expr e1 pp_expr e2 |
86 | 22fe1c93 | ploc | | Expr_fby (e1, e2) -> fprintf fmt "%a fby %a" pp_expr e1 pp_expr e2 |
87 | | Expr_pre e -> fprintf fmt "pre %a" pp_expr e |
||
88 | | Expr_when (e, id, l) -> fprintf fmt "%a when %s(%s)" pp_expr e l id |
||
89 | | Expr_merge (id, hl) -> |
||
90 | fprintf fmt "merge %s %a" id pp_handlers hl |
||
91 | | Expr_appl (id, e, r) -> pp_app fmt id e r |
||
92 | af5af1e8 | ploc | ) |
93 | 22fe1c93 | ploc | and pp_tuple fmt el = |
94 | fprintf_list ~sep:"," pp_expr fmt el |
||
95 | |||
96 | and pp_handler fmt (t, h) = |
||
97 | fprintf fmt "(%s -> %a)" t pp_expr h |
||
98 | |||
99 | and pp_handlers fmt hl = |
||
100 | fprintf_list ~sep:" " pp_handler fmt hl |
||
101 | |||
102 | and pp_app fmt id e r = |
||
103 | match r with |
||
104 | 70df2f87 | xthirioux | | None -> pp_call fmt id e |
105 | 54d032f5 | xthirioux | | Some c -> fprintf fmt "%t every (%a)" (fun fmt -> pp_call fmt id e) pp_expr c |
106 | 70df2f87 | xthirioux | |
107 | and pp_call fmt id e = |
||
108 | match id, e.expr_desc with |
||
109 | | "+", Expr_tuple([e1;e2]) -> fprintf fmt "(%a + %a)" pp_expr e1 pp_expr e2 |
||
110 | | "uminus", _ -> fprintf fmt "(- %a)" pp_expr e |
||
111 | | "-", Expr_tuple([e1;e2]) -> fprintf fmt "(%a - %a)" pp_expr e1 pp_expr e2 |
||
112 | | "*", Expr_tuple([e1;e2]) -> fprintf fmt "(%a * %a)" pp_expr e1 pp_expr e2 |
||
113 | | "/", Expr_tuple([e1;e2]) -> fprintf fmt "(%a / %a)" pp_expr e1 pp_expr e2 |
||
114 | | "mod", Expr_tuple([e1;e2]) -> fprintf fmt "(%a mod %a)" pp_expr e1 pp_expr e2 |
||
115 | | "&&", Expr_tuple([e1;e2]) -> fprintf fmt "(%a and %a)" pp_expr e1 pp_expr e2 |
||
116 | | "||", Expr_tuple([e1;e2]) -> fprintf fmt "(%a or %a)" pp_expr e1 pp_expr e2 |
||
117 | | "xor", Expr_tuple([e1;e2]) -> fprintf fmt "(%a xor %a)" pp_expr e1 pp_expr e2 |
||
118 | | "impl", Expr_tuple([e1;e2]) -> fprintf fmt "(%a => %a)" pp_expr e1 pp_expr e2 |
||
119 | | "<", Expr_tuple([e1;e2]) -> fprintf fmt "(%a < %a)" pp_expr e1 pp_expr e2 |
||
120 | | "<=", Expr_tuple([e1;e2]) -> fprintf fmt "(%a <= %a)" pp_expr e1 pp_expr e2 |
||
121 | | ">", Expr_tuple([e1;e2]) -> fprintf fmt "(%a > %a)" pp_expr e1 pp_expr e2 |
||
122 | | ">=", Expr_tuple([e1;e2]) -> fprintf fmt "(%a >= %a)" pp_expr e1 pp_expr e2 |
||
123 | | "!=", Expr_tuple([e1;e2]) -> fprintf fmt "(%a != %a)" pp_expr e1 pp_expr e2 |
||
124 | | "=", Expr_tuple([e1;e2]) -> fprintf fmt "(%a = %a)" pp_expr e1 pp_expr e2 |
||
125 | | "not", _ -> fprintf fmt "(not %a)" pp_expr e |
||
126 | | _, Expr_tuple _ -> fprintf fmt "%s %a" id pp_expr e |
||
127 | | _ -> fprintf fmt "%s (%a)" id pp_expr e |
||
128 | af5af1e8 | ploc | |
129 | and pp_eexpr fmt e = |
||
130 | fprintf fmt "%a%t %a" |
||
131 | (Utils.fprintf_list ~sep:"; " pp_quantifiers) e.eexpr_quantifiers |
||
132 | (fun fmt -> match e.eexpr_quantifiers with [] -> () | _ -> fprintf fmt ";") |
||
133 | pp_expr e.eexpr_qfexpr |
||
134 | |||
135 | 1b57e111 | Teme | and pp_sf_value fmt e = |
136 | fprintf fmt "%a" |
||
137 | (* (Utils.fprintf_list ~sep:"; " pp_quantifiers) e.eexpr_quantifiers *) |
||
138 | (* (fun fmt -> match e.eexpr_quantifiers *) |
||
139 | (* with [] -> () *) |
||
140 | (* | _ -> fprintf fmt ";") *) |
||
141 | pp_expr e.eexpr_qfexpr |
||
142 | |||
143 | and pp_s_function fmt expr_ann = |
||
144 | let pp_annot fmt (kwds, ee) = |
||
145 | Format.fprintf fmt " %t : %a" |
||
146 | (fun fmt -> match kwds with |
||
147 | | [] -> assert false |
||
148 | | [x] -> Format.pp_print_string fmt x |
||
149 | | _ -> Format.fprintf fmt "%a" (fprintf_list ~sep:"/" Format.pp_print_string) kwds) |
||
150 | pp_sf_value ee |
||
151 | in |
||
152 | fprintf_list ~sep:"@ " pp_annot fmt expr_ann.annots |
||
153 | af5af1e8 | ploc | |
154 | and pp_expr_annot fmt expr_ann = |
||
155 | let pp_annot fmt (kwds, ee) = |
||
156 | 04a63d25 | xthirioux | Format.fprintf fmt "(*! %t: %a; *)" |
157 | af5af1e8 | ploc | (fun fmt -> match kwds with | [] -> assert false | [x] -> Format.pp_print_string fmt x | _ -> Format.fprintf fmt "/%a/" (fprintf_list ~sep:"/" Format.pp_print_string) kwds) |
158 | pp_eexpr ee |
||
159 | in |
||
160 | fprintf_list ~sep:"@ " pp_annot fmt expr_ann.annots |
||
161 | |||
162 | ec433d69 | xthirioux | (* |
163 | let pp_node_var fmt id = fprintf fmt "%s%s: %a(%a)%a" (if id.var_dec_const then "const " else "") id.var_id print_dec_ty id.var_dec_type.ty_dec_desc Types.print_ty id.var_type Clocks.print_ck_suffix id.var_clock |
||
164 | *) |
||
165 | let pp_node_var fmt id = |
||
166 | begin |
||
167 | fprintf fmt "%s%s: %a%a" (if id.var_dec_const then "const " else "") id.var_id Types.print_node_ty id.var_type Clocks.print_ck_suffix id.var_clock; |
||
168 | match id.var_dec_value with |
||
169 | | None -> () |
||
170 | | Some v -> fprintf fmt " = %a" pp_expr v |
||
171 | end |
||
172 | |||
173 | let pp_node_args = fprintf_list ~sep:"; " pp_node_var |
||
174 | |||
175 | 22fe1c93 | ploc | let pp_node_eq fmt eq = |
176 | fprintf fmt "%a = %a;" |
||
177 | pp_eq_lhs eq.eq_lhs |
||
178 | pp_expr eq.eq_rhs |
||
179 | |||
180 | b08ffca7 | xthirioux | let pp_restart fmt restart = |
181 | Format.fprintf fmt "%s" (if restart then "restart" else "resume") |
||
182 | |||
183 | let pp_unless fmt (_, expr, restart, st) = |
||
184 | 54d032f5 | xthirioux | Format.fprintf fmt "unless %a %a %s@ " |
185 | b08ffca7 | xthirioux | pp_expr expr |
186 | pp_restart restart |
||
187 | st |
||
188 | |||
189 | let pp_until fmt (_, expr, restart, st) = |
||
190 | 54d032f5 | xthirioux | Format.fprintf fmt "until %a %a %s@ " |
191 | b08ffca7 | xthirioux | pp_expr expr |
192 | pp_restart restart |
||
193 | st |
||
194 | |||
195 | let rec pp_handler fmt handler = |
||
196 | 54d032f5 | xthirioux | Format.fprintf fmt "state %s ->@ @[<v 2> %a%alet@,@[<v 2> %a@]@,tel%a@]" |
197 | b08ffca7 | xthirioux | handler.hand_state |
198 | 54d032f5 | xthirioux | (Utils.fprintf_list ~sep:"@," pp_unless) handler.hand_unless |
199 | b08ffca7 | xthirioux | (fun fmt locals -> |
200 | match locals with [] -> () | _ -> |
||
201 | Format.fprintf fmt "@[<v 4>var %a@]@ " |
||
202 | (Utils.fprintf_list ~sep:"@ " |
||
203 | (fun fmt v -> Format.fprintf fmt "%a;" pp_node_var v)) |
||
204 | locals) |
||
205 | handler.hand_locals |
||
206 | pp_node_stmts handler.hand_stmts |
||
207 | 54d032f5 | xthirioux | (Utils.fprintf_list ~sep:"@," pp_until) handler.hand_until |
208 | b08ffca7 | xthirioux | |
209 | and pp_node_stmt fmt stmt = |
||
210 | match stmt with |
||
211 | | Eq eq -> pp_node_eq fmt eq |
||
212 | | Aut aut -> pp_node_aut fmt aut |
||
213 | |||
214 | and pp_node_stmts fmt stmts = fprintf_list ~sep:"@ " pp_node_stmt fmt stmts |
||
215 | |||
216 | and pp_node_aut fmt aut = |
||
217 | 54d032f5 | xthirioux | Format.fprintf fmt "@[<v 0>automaton %s@,%a@]" |
218 | b08ffca7 | xthirioux | aut.aut_id |
219 | (Utils.fprintf_list ~sep:"@ " pp_handler) aut.aut_handlers |
||
220 | |||
221 | and pp_node_eqs fmt eqs = fprintf_list ~sep:"@ " pp_node_eq fmt eqs |
||
222 | 22fe1c93 | ploc | |
223 | b1655a21 | xthirioux | let rec pp_var_struct_type_field fmt (label, tdesc) = |
224 | fprintf fmt "%a : %a;" pp_print_string label pp_var_type_dec_desc tdesc |
||
225 | and pp_var_type_dec_desc fmt tdesc = |
||
226 | match tdesc with |
||
227 | | Tydec_any -> fprintf fmt "<any>" |
||
228 | | Tydec_int -> fprintf fmt "int" |
||
229 | | Tydec_real -> fprintf fmt "real" |
||
230 | 04a63d25 | xthirioux | (* | Tydec_float -> fprintf fmt "float" *) |
231 | b1655a21 | xthirioux | | Tydec_bool -> fprintf fmt "bool" |
232 | | Tydec_clock t -> fprintf fmt "%a clock" pp_var_type_dec_desc t |
||
233 | | Tydec_const t -> fprintf fmt "%s" t |
||
234 | | Tydec_enum id_list -> fprintf fmt "enum {%a }" (fprintf_list ~sep:", " pp_print_string) id_list |
||
235 | | Tydec_struct f_list -> fprintf fmt "struct {%a }" (fprintf_list ~sep:" " pp_var_struct_type_field) f_list |
||
236 | | Tydec_array (s, t) -> fprintf fmt "%a^%a" pp_var_type_dec_desc t Dimension.pp_dimension s |
||
237 | 22fe1c93 | ploc | |
238 | let pp_var_type_dec fmt ty = |
||
239 | b1655a21 | xthirioux | pp_var_type_dec_desc fmt ty.ty_dec_desc |
240 | |||
241 | ef34b4ae | xthirioux | let pp_typedef fmt ty = |
242 | fprintf fmt "type %s = %a;@ " ty.tydef_id pp_var_type_dec_desc ty.tydef_desc |
||
243 | |||
244 | let pp_typedec fmt ty = |
||
245 | fprintf fmt "type %s;@ " ty.tydec_id |
||
246 | 22fe1c93 | ploc | |
247 | (* let rec pp_var_type fmt ty = *) |
||
248 | (* fprintf fmt "%a" (match ty.tdesc with *) |
||
249 | (* | Tvar | Tarrow | Tlink | Tunivar -> assert false *) |
||
250 | (* | Tint -> pp_print_string fmt "int" *) |
||
251 | (* | Treal -> pp_print_string fmt "real" *) |
||
252 | (* | Tbool -> pp_print_string fmt "bool" *) |
||
253 | (* | Trat -> pp_print_string fmt "rat" *) |
||
254 | (* | Tclock -> pp_print_string fmt "clock" *) |
||
255 | (* | Ttuple tel -> fprintf_list ~sep:" * " pp_var_type fmt tel *) |
||
256 | (* ) *) |
||
257 | |||
258 | e2380d4d | ploc | |
259 | let pp_spec fmt spec = |
||
260 | fprintf fmt "@[<hov 2>(*@@ "; |
||
261 | 521e2a6b | ploc | fprintf_list ~sep:"@,@@ " (fun fmt r -> fprintf fmt "requires %a;" pp_eexpr r) fmt spec.requires; |
262 | fprintf_list ~sep:"@,@@ " (fun fmt r -> fprintf fmt "ensures %a; " pp_eexpr r) fmt spec.ensures; |
||
263 | fprintf_list ~sep:"@," (fun fmt (name, assumes, ensures, _) -> |
||
264 | e2380d4d | ploc | fprintf fmt "behavior %s:@[@ %a@ %a@]" |
265 | name |
||
266 | (fprintf_list ~sep:"@ " (fun fmt r -> fprintf fmt "assumes %a;" pp_eexpr r)) assumes |
||
267 | 01c7d5e1 | ploc | (fprintf_list ~sep:"@ " (fun fmt r -> fprintf fmt "ensures %a;" pp_eexpr r)) ensures |
268 | e2380d4d | ploc | ) fmt spec.behaviors; |
269 | fprintf fmt "@]*)"; |
||
270 | () |
||
271 | |||
272 | af5af1e8 | ploc | |
273 | let pp_asserts fmt asserts = |
||
274 | match asserts with |
||
275 | | _::_ -> ( |
||
276 | fprintf fmt "(* Asserts definitions *)@ "; |
||
277 | fprintf_list ~sep:"@ " (fun fmt assert_ -> |
||
278 | let expr = assert_.assert_expr in |
||
279 | fprintf fmt "assert %a;" pp_expr expr |
||
280 | ) fmt asserts |
||
281 | ) |
||
282 | | _ -> () |
||
283 | |||
284 | 22fe1c93 | ploc | let pp_node fmt nd = |
285 | 521e2a6b | ploc | fprintf fmt "@[<v 0>%a%t%s %s (%a) returns (%a)@ %a%alet@[<h 2> @ @[<v>%a@ %a@ %a@]@]@ tel@]@ " |
286 | e2380d4d | ploc | (fun fmt s -> match s with Some s -> pp_spec fmt s | _ -> ()) nd.node_spec |
287 | 521e2a6b | ploc | (fun fmt -> match nd.node_spec with None -> () | Some _ -> Format.fprintf fmt "@ ") |
288 | 52cfee34 | xthirioux | (if nd.node_dec_stateless then "function" else "node") |
289 | 22fe1c93 | ploc | nd.node_id |
290 | pp_node_args nd.node_inputs |
||
291 | pp_node_args nd.node_outputs |
||
292 | (fun fmt locals -> |
||
293 | match locals with [] -> () | _ -> |
||
294 | fprintf fmt "@[<v 4>var %a@]@ " |
||
295 | (fprintf_list ~sep:"@ " |
||
296 | 7291cb80 | xthirioux | (fun fmt v -> fprintf fmt "%a;" pp_node_var v)) |
297 | 22fe1c93 | ploc | locals |
298 | ) nd.node_locals |
||
299 | (fun fmt checks -> |
||
300 | match checks with [] -> () | _ -> |
||
301 | fprintf fmt "@[<v 4>check@ %a@]@ " |
||
302 | (fprintf_list ~sep:"@ " |
||
303 | (fun fmt d -> fprintf fmt "%a" Dimension.pp_dimension d)) |
||
304 | checks |
||
305 | ) nd.node_checks |
||
306 | af5af1e8 | ploc | (fprintf_list ~sep:"@ " pp_expr_annot) nd.node_annot |
307 | b08ffca7 | xthirioux | pp_node_stmts nd.node_stmts |
308 | af5af1e8 | ploc | pp_asserts nd.node_asserts |
309 | 22fe1c93 | ploc | (*fprintf fmt "@ /* Scheduling: %a */ @ " (fprintf_list ~sep:", " pp_print_string) (Scheduling.schedule_node nd)*) |
310 | |||
311 | let pp_imported_node fmt ind = |
||
312 | ef34b4ae | xthirioux | fprintf fmt "@[<v>%s %s (%a) returns (%a)@]" |
313 | 52cfee34 | xthirioux | (if ind.nodei_stateless then "function" else "node") |
314 | 22fe1c93 | ploc | ind.nodei_id |
315 | pp_node_args ind.nodei_inputs |
||
316 | pp_node_args ind.nodei_outputs |
||
317 | |||
318 | ef34b4ae | xthirioux | let pp_const_decl fmt cdecl = |
319 | fprintf fmt "%s = %a;" cdecl.const_id pp_const cdecl.const_value |
||
320 | |||
321 | let pp_const_decl_list fmt clist = |
||
322 | fprintf_list ~sep:"@ " pp_const_decl fmt clist |
||
323 | 54ae8ac7 | ploc | |
324 | 22fe1c93 | ploc | let pp_decl fmt decl = |
325 | match decl.top_decl_desc with |
||
326 | | Node nd -> fprintf fmt "%a@ " pp_node nd |
||
327 | | ImportedNode ind -> |
||
328 | fprintf fmt "imported %a;@ " pp_imported_node ind |
||
329 | ef34b4ae | xthirioux | | Const c -> fprintf fmt "const %a@ " pp_const_decl c |
330 | | Open (local, s) -> if local then fprintf fmt "#open \"%s\"@ " s else fprintf fmt "#open <%s>@ " s |
||
331 | | TypeDef tdef -> fprintf fmt "%a@ " pp_typedef tdef |
||
332 | 22fe1c93 | ploc | |
333 | let pp_prog fmt prog = |
||
334 | fprintf_list ~sep:"@ " pp_decl fmt prog |
||
335 | |||
336 | let pp_short_decl fmt decl = |
||
337 | match decl.top_decl_desc with |
||
338 | | Node nd -> fprintf fmt "node %s@ " nd.node_id |
||
339 | | ImportedNode ind -> fprintf fmt "imported node %s" ind.nodei_id |
||
340 | ef34b4ae | xthirioux | | Const c -> fprintf fmt "const %a@ " pp_const_decl c |
341 | | Open (local, s) -> if local then fprintf fmt "#open \"%s\"@ " s else fprintf fmt "#open <%s>@ " s |
||
342 | | TypeDef tdef -> fprintf fmt "type %s;@ " tdef.tydef_id |
||
343 | 22fe1c93 | ploc | |
344 | 5c1184ad | ploc | let pp_lusi fmt decl = |
345 | match decl.top_decl_desc with |
||
346 | ef34b4ae | xthirioux | | ImportedNode ind -> fprintf fmt "%a;@ " pp_imported_node ind |
347 | | Const c -> fprintf fmt "const %a@ " pp_const_decl c |
||
348 | | Open (local, s) -> if local then fprintf fmt "#open \"%s\"@ " s else fprintf fmt "#open <%s>@ " s |
||
349 | | TypeDef tdef -> fprintf fmt "%a@ " pp_typedef tdef |
||
350 | | Node _ -> assert false |
||
351 | |||
352 | let pp_lusi_header fmt basename prog = |
||
353 | 521e2a6b | ploc | fprintf fmt "@[<v 0>"; |
354 | fprintf fmt "(* Generated Lustre Interface file from %s.lus *)@ " basename; |
||
355 | fprintf fmt "(* by Lustre-C compiler version %s, %a *)@ " Version.number pp_date (Unix.gmtime (Unix.time ())); |
||
356 | fprintf fmt "(* Feel free to mask some of the definitions by removing them from this file. *)@ @ "; |
||
357 | List.iter (fprintf fmt "%a@ " pp_lusi) prog; |
||
358 | fprintf fmt "@]" |
||
359 | d7b73fed | xthirioux | |
360 | let pp_offset fmt offset = |
||
361 | match offset with |
||
362 | | Index i -> fprintf fmt "[%a]" Dimension.pp_dimension i |
||
363 | | Field f -> fprintf fmt ".%s" f |
||
364 | |||
365 | 22fe1c93 | ploc | (* Local Variables: *) |
366 | (* compile-command:"make -C .." *) |
||
367 | (* End: *) |