1
|
(********************************************************************)
|
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
|
open LustreSpec
|
13
|
open Corelang
|
14
|
open Utils
|
15
|
|
16
|
(* Local annotations are declared with the following key /inlining/: true *)
|
17
|
let keyword = ["inlining"]
|
18
|
|
19
|
let is_inline_expr expr =
|
20
|
match expr.expr_annot with
|
21
|
| Some ann ->
|
22
|
List.exists (fun (key, value) -> key = keyword) ann.annots
|
23
|
| None -> false
|
24
|
|
25
|
let check_node_name id = (fun t ->
|
26
|
match t.top_decl_desc with
|
27
|
| Node nd -> nd.node_id = id
|
28
|
| _ -> false)
|
29
|
|
30
|
let is_node_var node v =
|
31
|
try
|
32
|
ignore (Corelang.get_node_var v node); true
|
33
|
with Not_found -> false
|
34
|
|
35
|
let rename_expr rename expr = expr_replace_var rename expr
|
36
|
|
37
|
let rename_eq rename eq =
|
38
|
{ eq with
|
39
|
eq_lhs = List.map rename eq.eq_lhs;
|
40
|
eq_rhs = rename_expr rename eq.eq_rhs
|
41
|
}
|
42
|
|
43
|
let rec add_expr_reset_cond cond expr =
|
44
|
let aux = add_expr_reset_cond cond in
|
45
|
let new_desc =
|
46
|
match expr.expr_desc with
|
47
|
| Expr_const _
|
48
|
| Expr_ident _ -> expr.expr_desc
|
49
|
| Expr_tuple el -> Expr_tuple (List.map aux el)
|
50
|
| Expr_ite (c, t, e) -> Expr_ite (aux c, aux t, aux e)
|
51
|
|
52
|
| Expr_arrow (e1, e2) ->
|
53
|
(* we replace the expression e1 -> e2 by e1 -> (if cond then e1 else e2) *)
|
54
|
let e1 = aux e1 and e2 = aux e2 in
|
55
|
(* inlining is performed before typing. we can leave the fields free *)
|
56
|
let new_e2 = mkexpr expr.expr_loc (Expr_ite (cond, e1, e2)) in
|
57
|
Expr_arrow (e1, new_e2)
|
58
|
|
59
|
| Expr_fby _ -> assert false (* TODO: deal with fby. This hasn't been much handled yet *)
|
60
|
|
61
|
| Expr_array el -> Expr_array (List.map aux el)
|
62
|
| Expr_access (e, dim) -> Expr_access (aux e, dim)
|
63
|
| Expr_power (e, dim) -> Expr_power (aux e, dim)
|
64
|
| Expr_pre e -> Expr_pre (aux e)
|
65
|
| Expr_when (e, id, l) -> Expr_when (aux e, id, l)
|
66
|
| Expr_merge (id, cases) -> Expr_merge (id, List.map (fun (l,e) -> l, aux e) cases)
|
67
|
|
68
|
| Expr_appl (id, args, reset_opt) ->
|
69
|
(* we "add" cond to the reset field. *)
|
70
|
let new_reset = match reset_opt with
|
71
|
None -> cond
|
72
|
| Some cond' -> mkpredef_call cond'.expr_loc "||" [cond; cond']
|
73
|
in
|
74
|
Expr_appl (id, args, Some new_reset)
|
75
|
|
76
|
|
77
|
in
|
78
|
{ expr with expr_desc = new_desc }
|
79
|
|
80
|
let add_eq_reset_cond cond eq =
|
81
|
{ eq with eq_rhs = add_expr_reset_cond cond eq.eq_rhs }
|
82
|
(*
|
83
|
let get_static_inputs input_arg_list =
|
84
|
List.fold_right (fun (vdecl, arg) res ->
|
85
|
if vdecl.var_dec_const
|
86
|
then (vdecl.var_id, Corelang.dimension_of_expr arg) :: res
|
87
|
else res)
|
88
|
input_arg_list []
|
89
|
|
90
|
let get_carrier_inputs input_arg_list =
|
91
|
List.fold_right (fun (vdecl, arg) res ->
|
92
|
if Corelang.is_clock_dec_type vdecl.var_dec_type.ty_dec_desc
|
93
|
then (vdecl.var_id, ident_of_expr arg) :: res
|
94
|
else res)
|
95
|
input_arg_list []
|
96
|
*)
|
97
|
|
98
|
|
99
|
(*
|
100
|
expr, locals', eqs = inline_call id args' reset locals node nodes
|
101
|
|
102
|
We select the called node equations and variables.
|
103
|
renamed_inputs = args
|
104
|
renamed_eqs
|
105
|
|
106
|
the resulting expression is tuple_of_renamed_outputs
|
107
|
|
108
|
TODO: convert the specification/annotation/assert and inject them
|
109
|
*)
|
110
|
(** [inline_call node loc uid args reset locals caller] returns a tuple (expr,
|
111
|
locals, eqs, asserts)
|
112
|
*)
|
113
|
let inline_call node loc uid args reset locals caller =
|
114
|
let rename v =
|
115
|
if v = tag_true || v = tag_false || not (is_node_var node v) then v else
|
116
|
Corelang.mk_new_node_name caller (Format.sprintf "%s_%i_%s" node.node_id uid v)
|
117
|
in
|
118
|
let eqs' = List.map (rename_eq rename) (get_node_eqs node) in
|
119
|
let input_arg_list = List.combine node.node_inputs (Corelang.expr_list_of_expr args) in
|
120
|
let static_inputs, dynamic_inputs = List.partition (fun (vdecl, arg) -> vdecl.var_dec_const) input_arg_list in
|
121
|
let static_inputs = List.map (fun (vdecl, arg) -> vdecl, Corelang.dimension_of_expr arg) static_inputs in
|
122
|
let carrier_inputs, other_inputs = List.partition (fun (vdecl, arg) -> Corelang.is_clock_dec_type vdecl.var_dec_type.ty_dec_desc) dynamic_inputs in
|
123
|
let carrier_inputs = List.map (fun (vdecl, arg) -> vdecl, Corelang.ident_of_expr arg) carrier_inputs in
|
124
|
let rename_static v =
|
125
|
try
|
126
|
snd (List.find (fun (vdecl, _) -> v = vdecl.var_id) static_inputs)
|
127
|
with Not_found -> Dimension.mkdim_ident loc v in
|
128
|
let rename_carrier v =
|
129
|
try
|
130
|
snd (List.find (fun (vdecl, _) -> v = vdecl.var_id) carrier_inputs)
|
131
|
with Not_found -> v in
|
132
|
let rename_var v =
|
133
|
let vdecl =
|
134
|
Corelang.mkvar_decl v.var_loc
|
135
|
(rename v.var_id,
|
136
|
{ v.var_dec_type with ty_dec_desc = Corelang.rename_static rename_static v.var_dec_type.ty_dec_desc },
|
137
|
{ v.var_dec_clock with ck_dec_desc = Corelang.rename_carrier rename_carrier v.var_dec_clock.ck_dec_desc },
|
138
|
v.var_dec_const,
|
139
|
Utils.option_map (rename_expr rename) v.var_dec_value) in
|
140
|
begin
|
141
|
(*
|
142
|
(try
|
143
|
Format.eprintf "Inliner.inline_call unify %a %a@." Types.print_ty vdecl.var_type Dimension.pp_dimension (List.assoc v.var_id static_inputs);
|
144
|
Typing.unify vdecl.var_type (Type_predef.type_static (List.assoc v.var_id static_inputs) (Types.new_var ()))
|
145
|
with Not_found -> ());
|
146
|
(try
|
147
|
Clock_calculus.unify vdecl.var_clock (Clock_predef.ck_carrier (List.assoc v.var_id carrier_inputs) (Clocks.new_var true))
|
148
|
with Not_found -> ());
|
149
|
(*Format.eprintf "Inliner.inline_call res=%a@." Printers.pp_var vdecl;*)
|
150
|
*)
|
151
|
vdecl
|
152
|
end
|
153
|
(*Format.eprintf "Inliner.rename_var %a@." Printers.pp_var v;*)
|
154
|
in
|
155
|
let inputs' = List.map (fun (vdecl, _) -> rename_var vdecl) dynamic_inputs in
|
156
|
let outputs' = List.map rename_var node.node_outputs in
|
157
|
let locals' =
|
158
|
(List.map (fun (vdecl, arg) -> let vdecl' = rename_var vdecl in { vdecl' with var_dec_value = Some (Corelang.expr_of_dimension arg) }) static_inputs)
|
159
|
@ (List.map rename_var node.node_locals)
|
160
|
in
|
161
|
(* checking we are at the appropriate (early) step: node_checks and
|
162
|
node_gencalls should be empty (not yet assigned) *)
|
163
|
assert (node.node_checks = []);
|
164
|
assert (node.node_gencalls = []);
|
165
|
|
166
|
(* Expressing reset locally in equations *)
|
167
|
let eqs_r' =
|
168
|
match reset with
|
169
|
None -> eqs'
|
170
|
| Some cond -> List.map (add_eq_reset_cond cond) eqs'
|
171
|
in
|
172
|
let assign_inputs = mkeq loc (List.map (fun v -> v.var_id) inputs',
|
173
|
expr_of_expr_list args.expr_loc (List.map snd dynamic_inputs)) in
|
174
|
let expr = expr_of_expr_list loc (List.map expr_of_vdecl outputs')
|
175
|
in
|
176
|
let asserts' = (* We rename variables in assert expressions *)
|
177
|
List.map
|
178
|
(fun a ->
|
179
|
{a with assert_expr =
|
180
|
let expr = a.assert_expr in
|
181
|
rename_expr rename expr
|
182
|
})
|
183
|
node.node_asserts
|
184
|
in
|
185
|
let annots' =
|
186
|
Plugins.inline_annots rename node.node_annot
|
187
|
in
|
188
|
expr,
|
189
|
inputs'@outputs'@locals'@locals,
|
190
|
assign_inputs::eqs_r',
|
191
|
asserts',
|
192
|
annots'
|
193
|
|
194
|
|
195
|
|
196
|
let inline_table = Hashtbl.create 23
|
197
|
|
198
|
(*
|
199
|
new_expr, new_locals, new_eqs = inline_expr expr locals node nodes
|
200
|
|
201
|
Each occurence of a node in nodes in the expr should be replaced by fresh
|
202
|
variables and the code of called node instance added to new_eqs
|
203
|
|
204
|
*)
|
205
|
let rec inline_expr ?(selection_on_annotation=false) expr locals node nodes =
|
206
|
let inline_expr = inline_expr ~selection_on_annotation:selection_on_annotation in
|
207
|
let inline_node = inline_node ~selection_on_annotation:selection_on_annotation in
|
208
|
let inline_tuple el =
|
209
|
List.fold_right (fun e (el_tail, locals, eqs, asserts, annots) ->
|
210
|
let e', locals', eqs', asserts', annots' = inline_expr e locals node nodes in
|
211
|
e'::el_tail, locals', eqs'@eqs, asserts@asserts', annots@annots'
|
212
|
) el ([], locals, [], [], [])
|
213
|
in
|
214
|
let inline_pair e1 e2 =
|
215
|
let el', l', eqs', asserts', annots' = inline_tuple [e1;e2] in
|
216
|
match el' with
|
217
|
| [e1'; e2'] -> e1', e2', l', eqs', asserts', annots'
|
218
|
| _ -> assert false
|
219
|
in
|
220
|
let inline_triple e1 e2 e3 =
|
221
|
let el', l', eqs', asserts', annots' = inline_tuple [e1;e2;e3] in
|
222
|
match el' with
|
223
|
| [e1'; e2'; e3'] -> e1', e2', e3', l', eqs', asserts', annots'
|
224
|
| _ -> assert false
|
225
|
in
|
226
|
|
227
|
match expr.expr_desc with
|
228
|
| Expr_appl (id, args, reset) ->
|
229
|
let args', locals', eqs', asserts', annots' = inline_expr args locals node nodes in
|
230
|
if List.exists (check_node_name id) nodes && (* the current node call is provided
|
231
|
as arguments nodes *)
|
232
|
(not selection_on_annotation || is_inline_expr expr) (* and if selection on annotation is activated,
|
233
|
it is explicitely inlined here *)
|
234
|
then
|
235
|
(* The node should be inlined *)
|
236
|
(* let _ = Format.eprintf "Inlining call to %s@." id in *)
|
237
|
let called = try List.find (check_node_name id) nodes
|
238
|
with Not_found -> (assert false) in
|
239
|
let called = node_of_top called in
|
240
|
let called' = inline_node called nodes in
|
241
|
let expr, locals', eqs'', asserts'', annots'' =
|
242
|
inline_call called' expr.expr_loc expr.expr_tag args' reset locals' node in
|
243
|
expr, locals', eqs'@eqs'', asserts'@asserts'', annots'@annots''
|
244
|
else
|
245
|
(* let _ = Format.eprintf "Not inlining call to %s@." id in *)
|
246
|
{ expr with expr_desc = Expr_appl(id, args', reset)},
|
247
|
locals',
|
248
|
eqs',
|
249
|
asserts',
|
250
|
annots'
|
251
|
|
252
|
(* For other cases, we just keep the structure, but convert sub-expressions *)
|
253
|
| Expr_const _
|
254
|
| Expr_ident _ -> expr, locals, [], [], []
|
255
|
| Expr_tuple el ->
|
256
|
let el', l', eqs', asserts', annots' = inline_tuple el in
|
257
|
{ expr with expr_desc = Expr_tuple el' }, l', eqs', asserts', annots'
|
258
|
| Expr_ite (g, t, e) ->
|
259
|
let g', t', e', l', eqs', asserts', annots' = inline_triple g t e in
|
260
|
{ expr with expr_desc = Expr_ite (g', t', e') }, l', eqs', asserts', annots'
|
261
|
| Expr_arrow (e1, e2) ->
|
262
|
let e1', e2', l', eqs', asserts', annots' = inline_pair e1 e2 in
|
263
|
{ expr with expr_desc = Expr_arrow (e1', e2') } , l', eqs', asserts', annots'
|
264
|
| Expr_fby (e1, e2) ->
|
265
|
let e1', e2', l', eqs', asserts', annots' = inline_pair e1 e2 in
|
266
|
{ expr with expr_desc = Expr_fby (e1', e2') }, l', eqs', asserts', annots'
|
267
|
| Expr_array el ->
|
268
|
let el', l', eqs', asserts', annots' = inline_tuple el in
|
269
|
{ expr with expr_desc = Expr_array el' }, l', eqs', asserts', annots'
|
270
|
| Expr_access (e, dim) ->
|
271
|
let e', l', eqs', asserts', annots' = inline_expr e locals node nodes in
|
272
|
{ expr with expr_desc = Expr_access (e', dim) }, l', eqs', asserts', annots'
|
273
|
| Expr_power (e, dim) ->
|
274
|
let e', l', eqs', asserts', annots' = inline_expr e locals node nodes in
|
275
|
{ expr with expr_desc = Expr_power (e', dim) }, l', eqs', asserts', annots'
|
276
|
| Expr_pre e ->
|
277
|
let e', l', eqs', asserts', annots' = inline_expr e locals node nodes in
|
278
|
{ expr with expr_desc = Expr_pre e' }, l', eqs', asserts', annots'
|
279
|
| Expr_when (e, id, label) ->
|
280
|
let e', l', eqs', asserts', annots' = inline_expr e locals node nodes in
|
281
|
{ expr with expr_desc = Expr_when (e', id, label) }, l', eqs', asserts', annots'
|
282
|
| Expr_merge (id, branches) ->
|
283
|
let el, l', eqs', asserts', annots' = inline_tuple (List.map snd branches) in
|
284
|
let branches' = List.map2 (fun (label, _) v -> label, v) branches el in
|
285
|
{ expr with expr_desc = Expr_merge (id, branches') }, l', eqs', asserts', annots'
|
286
|
|
287
|
and inline_node ?(selection_on_annotation=false) node nodes =
|
288
|
try copy_node (Hashtbl.find inline_table node.node_id)
|
289
|
with Not_found ->
|
290
|
let inline_expr = inline_expr ~selection_on_annotation:selection_on_annotation in
|
291
|
let new_locals, eqs, asserts, annots =
|
292
|
List.fold_left (fun (locals, eqs, asserts, annots) eq ->
|
293
|
let eq_rhs', locals', new_eqs', asserts', annots' =
|
294
|
inline_expr eq.eq_rhs locals node nodes
|
295
|
in
|
296
|
locals', { eq with eq_rhs = eq_rhs' }::new_eqs'@eqs, asserts'@asserts, annots'@annots
|
297
|
) (node.node_locals, [], node.node_asserts, node.node_annot) (get_node_eqs node)
|
298
|
in
|
299
|
let inlined =
|
300
|
{ node with
|
301
|
node_locals = new_locals;
|
302
|
node_stmts = List.map (fun eq -> Eq eq) eqs;
|
303
|
node_asserts = asserts;
|
304
|
node_annot = annots;
|
305
|
}
|
306
|
in
|
307
|
begin
|
308
|
(*Format.eprintf "inline node:<< %a@.>>@." Printers.pp_node inlined;*)
|
309
|
Hashtbl.add inline_table node.node_id inlined;
|
310
|
inlined
|
311
|
end
|
312
|
|
313
|
let inline_all_calls node nodes =
|
314
|
let nd = match node.top_decl_desc with Node nd -> nd | _ -> assert false in
|
315
|
{ node with top_decl_desc = Node (inline_node nd nodes) }
|
316
|
|
317
|
|
318
|
|
319
|
|
320
|
|
321
|
let witness filename main_name orig inlined type_env clock_env =
|
322
|
let loc = Location.dummy_loc in
|
323
|
let rename_local_node nodes prefix id =
|
324
|
if List.exists (check_node_name id) nodes then
|
325
|
prefix ^ id
|
326
|
else
|
327
|
id
|
328
|
in
|
329
|
let main_orig_node = match (List.find (check_node_name main_name) orig).top_decl_desc with
|
330
|
Node nd -> nd | _ -> assert false in
|
331
|
|
332
|
let orig_rename = rename_local_node orig "orig_" in
|
333
|
let inlined_rename = rename_local_node inlined "inlined_" in
|
334
|
let identity = (fun x -> x) in
|
335
|
let is_node top = match top.top_decl_desc with Node _ -> true | _ -> false in
|
336
|
let orig = rename_prog orig_rename identity identity orig in
|
337
|
let inlined = rename_prog inlined_rename identity identity inlined in
|
338
|
let nodes_origs, others = List.partition is_node orig in
|
339
|
let nodes_inlined, _ = List.partition is_node inlined in
|
340
|
|
341
|
(* One ok_i boolean variable per output var *)
|
342
|
let nb_outputs = List.length main_orig_node.node_outputs in
|
343
|
let ok_ident = "OK" in
|
344
|
let ok_i = List.map (fun id ->
|
345
|
mkvar_decl
|
346
|
loc
|
347
|
(Format.sprintf "%s_%i" ok_ident id,
|
348
|
{ty_dec_desc=Tydec_bool; ty_dec_loc=loc},
|
349
|
{ck_dec_desc=Ckdec_any; ck_dec_loc=loc},
|
350
|
false,
|
351
|
None)
|
352
|
) (Utils.enumerate nb_outputs)
|
353
|
in
|
354
|
|
355
|
(* OK = ok_1 and ok_2 and ... ok_n-1 *)
|
356
|
let ok_output = mkvar_decl
|
357
|
loc
|
358
|
(ok_ident,
|
359
|
{ty_dec_desc=Tydec_bool; ty_dec_loc=loc},
|
360
|
{ck_dec_desc=Ckdec_any; ck_dec_loc=loc},
|
361
|
false,
|
362
|
None)
|
363
|
in
|
364
|
let main_ok_expr =
|
365
|
let mkv x = mkexpr loc (Expr_ident x) in
|
366
|
match ok_i with
|
367
|
| [] -> assert false
|
368
|
| [x] -> mkv x.var_id
|
369
|
| hd::tl ->
|
370
|
List.fold_left (fun accu elem ->
|
371
|
mkpredef_call loc "&&" [mkv elem.var_id; accu]
|
372
|
) (mkv hd.var_id) tl
|
373
|
in
|
374
|
|
375
|
(* Building main node *)
|
376
|
|
377
|
let ok_i_eq =
|
378
|
{ eq_loc = loc;
|
379
|
eq_lhs = List.map (fun v -> v.var_id) ok_i;
|
380
|
eq_rhs =
|
381
|
let inputs = expr_of_expr_list loc (List.map (fun v -> mkexpr loc (Expr_ident v.var_id)) main_orig_node.node_inputs) in
|
382
|
let call_orig =
|
383
|
mkexpr loc (Expr_appl ("orig_" ^ main_name, inputs, None)) in
|
384
|
let call_inlined =
|
385
|
mkexpr loc (Expr_appl ("inlined_" ^ main_name, inputs, None)) in
|
386
|
let args = mkexpr loc (Expr_tuple [call_orig; call_inlined]) in
|
387
|
mkexpr loc (Expr_appl ("=", args, None))
|
388
|
} in
|
389
|
let ok_eq =
|
390
|
{ eq_loc = loc;
|
391
|
eq_lhs = [ok_ident];
|
392
|
eq_rhs = main_ok_expr;
|
393
|
} in
|
394
|
let main_node = {
|
395
|
node_id = "check";
|
396
|
node_type = Types.new_var ();
|
397
|
node_clock = Clocks.new_var true;
|
398
|
node_inputs = main_orig_node.node_inputs;
|
399
|
node_outputs = [ok_output];
|
400
|
node_locals = ok_i;
|
401
|
node_gencalls = [];
|
402
|
node_checks = [];
|
403
|
node_asserts = [];
|
404
|
node_stmts = [Eq ok_i_eq; Eq ok_eq];
|
405
|
node_dec_stateless = false;
|
406
|
node_stateless = None;
|
407
|
node_spec = Some
|
408
|
{requires = [];
|
409
|
ensures = [mkeexpr loc (mkexpr loc (Expr_ident ok_ident))];
|
410
|
behaviors = [];
|
411
|
spec_loc = loc
|
412
|
};
|
413
|
node_annot = [];
|
414
|
}
|
415
|
in
|
416
|
let main = [{ top_decl_desc = Node main_node; top_decl_loc = loc; top_decl_owner = filename; top_decl_itf = false }] in
|
417
|
let new_prog = others@nodes_origs@nodes_inlined@main in
|
418
|
(*
|
419
|
let _ = Typing.type_prog type_env new_prog in
|
420
|
let _ = Clock_calculus.clock_prog clock_env new_prog in
|
421
|
*)
|
422
|
|
423
|
let witness_file = (Options.get_witness_dir filename) ^ "/" ^ "inliner_witness.lus" in
|
424
|
let witness_out = open_out witness_file in
|
425
|
let witness_fmt = Format.formatter_of_out_channel witness_out in
|
426
|
begin
|
427
|
List.iter (fun vdecl -> Typing.try_unify Type_predef.type_bool vdecl.var_type vdecl.var_loc) (ok_output::ok_i);
|
428
|
Format.fprintf witness_fmt
|
429
|
"(* Generated lustre file to check validity of inlining process *)@.";
|
430
|
Printers.pp_prog witness_fmt new_prog;
|
431
|
Format.fprintf witness_fmt "@.";
|
432
|
()
|
433
|
end (* xx *)
|
434
|
|
435
|
let global_inline basename prog type_env clock_env =
|
436
|
(* We select the main node desc *)
|
437
|
let main_node, other_nodes, other_tops =
|
438
|
List.fold_right
|
439
|
(fun top (main_opt, nodes, others) ->
|
440
|
match top.top_decl_desc with
|
441
|
| Node nd when nd.node_id = !Options.main_node ->
|
442
|
Some top, nodes, others
|
443
|
| Node _ -> main_opt, top::nodes, others
|
444
|
| _ -> main_opt, nodes, top::others)
|
445
|
prog (None, [], [])
|
446
|
in
|
447
|
(* Recursively each call of a node in the top node is replaced *)
|
448
|
let main_node = Utils.desome main_node in
|
449
|
let main_node' = inline_all_calls main_node other_nodes in
|
450
|
let res = List.map (fun top -> if check_node_name !Options.main_node top then main_node' else top) prog in
|
451
|
res
|
452
|
|
453
|
let local_inline basename prog type_env clock_env =
|
454
|
let local_anns = Annotations.get_expr_annotations keyword in
|
455
|
if local_anns != [] then (
|
456
|
let nodes_with_anns = List.fold_left (fun accu (k, _) -> ISet.add k accu) ISet.empty local_anns in
|
457
|
ISet.iter (fun node_id -> Format.eprintf "Node %s has local expression annotations@." node_id) nodes_with_anns;
|
458
|
List.fold_right (fun top accu ->
|
459
|
( match top.top_decl_desc with
|
460
|
| Node nd when ISet.mem nd.node_id nodes_with_anns ->
|
461
|
{ top with top_decl_desc = Node (inline_node ~selection_on_annotation:true nd prog) }
|
462
|
| _ -> top
|
463
|
)::accu) prog []
|
464
|
|
465
|
)
|
466
|
else
|
467
|
prog
|
468
|
|
469
|
|
470
|
(* Local Variables: *)
|
471
|
(* compile-command:"make -C .." *)
|
472
|
(* End: *)
|