lustrec / src / normalization.ml @ ef8a361a
History  View  Annotate  Download (19.7 KB)
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 Utils 
13 
open LustreSpec 
14 
open Corelang 
15 
open Format 
16  
17 
(** Normalisation iters through the AST of expressions and bind fresh definition 
18 
when some criteria are met. This creation of fresh definition is performed by 
19 
the function mk_expr_alias_opt when the alias argument is on. 
20  
21 
Initial expressions, ie expressions attached a variable in an equation 
22 
definition are not aliased. This nonalias feature is propagated in the 
23 
expression AST for array access and power construct, tuple, and some special 
24 
cases of arrows. 
25  
26 
Two global variables may impact the normalization process: 
27 
 unfold_arrow_active 
28 
 force_alias_ite: when set, bind a fresh alias for then and else 
29 
definitions. 
30 
*) 
31  
32 
(* Two global variables *) 
33 
let unfold_arrow_active = ref true 
34 
let force_alias_ite = ref false 
35 
let force_alias_internal_fun = ref false 
36  
37 

38 
let expr_true loc ck = 
39 
{ expr_tag = Utils.new_tag (); 
40 
expr_desc = Expr_const (Const_tag tag_true); 
41 
expr_type = Type_predef.type_bool; 
42 
expr_clock = ck; 
43 
expr_delay = Delay.new_var (); 
44 
expr_annot = None; 
45 
expr_loc = loc } 
46  
47 
let expr_false loc ck = 
48 
{ expr_tag = Utils.new_tag (); 
49 
expr_desc = Expr_const (Const_tag tag_false); 
50 
expr_type = Type_predef.type_bool; 
51 
expr_clock = ck; 
52 
expr_delay = Delay.new_var (); 
53 
expr_annot = None; 
54 
expr_loc = loc } 
55  
56 
let expr_once loc ck = 
57 
{ expr_tag = Utils.new_tag (); 
58 
expr_desc = Expr_arrow (expr_true loc ck, expr_false loc ck); 
59 
expr_type = Type_predef.type_bool; 
60 
expr_clock = ck; 
61 
expr_delay = Delay.new_var (); 
62 
expr_annot = None; 
63 
expr_loc = loc } 
64  
65 
let is_expr_once = 
66 
let dummy_expr_once = expr_once Location.dummy_loc (Clocks.new_var true) in 
67 
fun expr > Corelang.is_eq_expr expr dummy_expr_once 
68  
69 
let unfold_arrow expr = 
70 
match expr.expr_desc with 
71 
 Expr_arrow (e1, e2) > 
72 
let loc = expr.expr_loc in 
73 
let ck = List.hd (Clocks.clock_list_of_clock expr.expr_clock) in 
74 
{ expr with expr_desc = Expr_ite (expr_once loc ck, e1, e2) } 
75 
 _ > assert false 
76  
77 
let cpt_fresh = ref 0 
78  
79 
(* Generate a new local [node] variable *) 
80 
let mk_fresh_var node loc ty ck = 
81 
let vars = get_node_vars node in 
82 
let rec aux () = 
83 
incr cpt_fresh; 
84 
let s = Printf.sprintf "__%s_%d" node.node_id !cpt_fresh in 
85 
if List.exists (fun v > v.var_id = s) vars then aux () else 
86 
{ 
87 
var_id = s; 
88 
var_orig = false; 
89 
var_dec_type = dummy_type_dec; 
90 
var_dec_clock = dummy_clock_dec; 
91 
var_dec_const = false; 
92 
var_dec_value = None; 
93 
var_type = ty; 
94 
var_clock = ck; 
95 
var_loc = loc 
96 
} 
97 
in aux () 
98  
99 
(* Get the equation in [defs] with [expr] as rhs, if any *) 
100 
let get_expr_alias defs expr = 
101 
try Some (List.find (fun eq > is_eq_expr eq.eq_rhs expr) defs) 
102 
with 
103 
 Not_found > None 
104 

105 
(* Replace [expr] with (tuple of) [locals] *) 
106 
let replace_expr locals expr = 
107 
match locals with 
108 
 [] > assert false 
109 
 [v] > { expr with 
110 
expr_tag = Utils.new_tag (); 
111 
expr_desc = Expr_ident v.var_id } 
112 
 _ > { expr with 
113 
expr_tag = Utils.new_tag (); 
114 
expr_desc = Expr_tuple (List.map expr_of_vdecl locals) } 
115  
116 
let unfold_offsets e offsets = 
117 
let add_offset e d = 
118 
(*Format.eprintf "add_offset %a(%a) %a @." Printers.pp_expr e Types.print_ty e.expr_type Dimension.pp_dimension d; 
119 
let res = *) 
120 
{ e with 
121 
expr_tag = Utils.new_tag (); 
122 
expr_loc = d.Dimension.dim_loc; 
123 
expr_type = Types.array_element_type e.expr_type; 
124 
expr_desc = Expr_access (e, d) } 
125 
(*in (Format.eprintf "= %a @." Printers.pp_expr res; res) *) 
126 
in 
127 
List.fold_left add_offset e offsets 
128  
129 
(* Create an alias for [expr], if none exists yet *) 
130 
let mk_expr_alias node (defs, vars) expr = 
131 
(*Format.eprintf "mk_expr_alias %a %a %a@." Printers.pp_expr expr Types.print_ty expr.expr_type Clocks.print_ck expr.expr_clock;*) 
132 
match get_expr_alias defs expr with 
133 
 Some eq > 
134 
let aliases = List.map (fun id > List.find (fun v > v.var_id = id) vars) eq.eq_lhs in 
135 
(defs, vars), replace_expr aliases expr 
136 
 None > 
137 
let new_aliases = 
138 
List.map2 
139 
(mk_fresh_var node expr.expr_loc) 
140 
(Types.type_list_of_type expr.expr_type) 
141 
(Clocks.clock_list_of_clock expr.expr_clock) in 
142 
let new_def = 
143 
mkeq expr.expr_loc (List.map (fun v > v.var_id) new_aliases, expr) 
144 
in 
145 
(* Format.eprintf "Checking def of alias: %a > %a@." (fprintf_list ~sep:", " (fun fmt v > Format.pp_print_string fmt v.var_id)) new_aliases Printers.pp_expr expr; *) 
146 
(new_def::defs, new_aliases@vars), replace_expr new_aliases expr 
147  
148 
(* Create an alias for [expr], if [expr] is not already an alias (i.e. an ident) 
149 
and [opt] is true *) 
150 
let mk_expr_alias_opt opt node (defs, vars) expr = 
151 
(*Format.eprintf "mk_expr_alias_opt %B %a %a %a@." opt Printers.pp_expr expr Types.print_ty expr.expr_type Clocks.print_ck expr.expr_clock;*) 
152 
match expr.expr_desc with 
153 
 Expr_ident alias > 
154 
(defs, vars), expr 
155 
 _ > 
156 
match get_expr_alias defs expr with 
157 
 Some eq > 
158 
let aliases = List.map (fun id > List.find (fun v > v.var_id = id) vars) eq.eq_lhs in 
159 
(defs, vars), replace_expr aliases expr 
160 
 None > 
161 
if opt 
162 
then 
163 
let new_aliases = 
164 
List.map2 
165 
(mk_fresh_var node expr.expr_loc) 
166 
(Types.type_list_of_type expr.expr_type) 
167 
(Clocks.clock_list_of_clock expr.expr_clock) in 
168 
let new_def = 
169 
mkeq expr.expr_loc (List.map (fun v > v.var_id) new_aliases, expr) 
170 
in (new_def::defs, new_aliases@vars), replace_expr new_aliases expr 
171 
else 
172 
(defs, vars), expr 
173  
174 
(* Create a (normalized) expression from [ref_e], 
175 
replacing description with [norm_d], 
176 
taking propagated [offsets] into account 
177 
in order to change expression type *) 
178 
let mk_norm_expr offsets ref_e norm_d = 
179 
(*Format.eprintf "mk_norm_expr %a %a @." Printers.pp_expr ref_e Printers.pp_expr { ref_e with expr_desc = norm_d};*) 
180 
let drop_array_type ty = 
181 
Types.map_tuple_type Types.array_element_type ty in 
182 
{ ref_e with 
183 
expr_desc = norm_d; 
184 
expr_type = Utils.repeat (List.length offsets) drop_array_type ref_e.expr_type } 
185 

186 
(* normalize_<foo> : defs * used vars > <foo> > (updated defs * updated vars) * normalized <foo> *) 
187 
let rec normalize_list alias node offsets norm_element defvars elist = 
188 
List.fold_right 
189 
(fun t (defvars, qlist) > 
190 
let defvars, norm_t = norm_element alias node offsets defvars t in 
191 
(defvars, norm_t :: qlist) 
192 
) elist (defvars, []) 
193  
194 
let rec normalize_expr ?(alias=true) node offsets defvars expr = 
195 
(*Format.eprintf "normalize %B %a:%a [%a]@." alias Printers.pp_expr expr Types.print_ty expr.expr_type (Utils.fprintf_list ~sep:"," Dimension.pp_dimension) offsets;*) 
196 
match expr.expr_desc with 
197 
 Expr_const _ 
198 
 Expr_ident _ > defvars, unfold_offsets expr offsets 
199 
 Expr_array elist > 
200 
let defvars, norm_elist = normalize_list alias node offsets (fun _ > normalize_array_expr ~alias:true) defvars elist in 
201 
let norm_expr = mk_norm_expr offsets expr (Expr_array norm_elist) in 
202 
mk_expr_alias_opt alias node defvars norm_expr 
203 
 Expr_power (e1, d) when offsets = [] > 
204 
let defvars, norm_e1 = normalize_expr node offsets defvars e1 in 
205 
let norm_expr = mk_norm_expr offsets expr (Expr_power (norm_e1, d)) in 
206 
mk_expr_alias_opt alias node defvars norm_expr 
207 
 Expr_power (e1, d) > 
208 
normalize_expr ~alias:alias node (List.tl offsets) defvars e1 
209 
 Expr_access (e1, d) > 
210 
normalize_expr ~alias:alias node (d::offsets) defvars e1 
211 
 Expr_tuple elist > 
212 
let defvars, norm_elist = 
213 
normalize_list alias node offsets (fun alias > normalize_expr ~alias:alias) defvars elist in 
214 
defvars, mk_norm_expr offsets expr (Expr_tuple norm_elist) 
215 
 Expr_appl (id, args, None) 
216 
when Basic_library.is_homomorphic_fun id 
217 
&& Types.is_array_type expr.expr_type > 
218 
let defvars, norm_args = 
219 
normalize_list 
220 
alias 
221 
node 
222 
offsets 
223 
(fun _ > normalize_array_expr ~alias:true) 
224 
defvars 
225 
(expr_list_of_expr args) 
226 
in 
227 
defvars, mk_norm_expr offsets expr (Expr_appl (id, expr_of_expr_list args.expr_loc norm_args, None)) 
228 
 Expr_appl (id, args, None) when Basic_library.is_expr_internal_fun expr 
229 
&& not !force_alias_internal_fun > 
230 
let defvars, norm_args = normalize_expr ~alias:true node offsets defvars args in 
231 
defvars, mk_norm_expr offsets expr (Expr_appl (id, norm_args, None)) 
232 
 Expr_appl (id, args, r) > 
233 
let defvars, norm_args = normalize_expr node [] defvars args in 
234 
let norm_expr = mk_norm_expr [] expr (Expr_appl (id, norm_args, r)) in 
235 
if offsets <> [] 
236 
then 
237 
let defvars, norm_expr = normalize_expr node [] defvars norm_expr in 
238 
normalize_expr ~alias:alias node offsets defvars norm_expr 
239 
else 
240 
mk_expr_alias_opt (alias && (!force_alias_internal_fun 
241 
 not (Basic_library.is_expr_internal_fun expr))) 
242 
node defvars norm_expr 
243 
 Expr_arrow (e1,e2) when !unfold_arrow_active && not (is_expr_once expr) > 
244 
(* Here we differ from Colaco paper: arrows are pushed to the top *) 
245 
normalize_expr ~alias:alias node offsets defvars (unfold_arrow expr) 
246 
 Expr_arrow (e1,e2) > 
247 
let defvars, norm_e1 = normalize_expr node offsets defvars e1 in 
248 
let defvars, norm_e2 = normalize_expr node offsets defvars e2 in 
249 
let norm_expr = mk_norm_expr offsets expr (Expr_arrow (norm_e1, norm_e2)) in 
250 
mk_expr_alias_opt alias node defvars norm_expr 
251 
 Expr_pre e > 
252 
let defvars, norm_e = normalize_expr node offsets defvars e in 
253 
let norm_expr = mk_norm_expr offsets expr (Expr_pre norm_e) in 
254 
mk_expr_alias_opt alias node defvars norm_expr 
255 
 Expr_fby (e1, e2) > 
256 
let defvars, norm_e1 = normalize_expr node offsets defvars e1 in 
257 
let defvars, norm_e2 = normalize_expr node offsets defvars e2 in 
258 
let norm_expr = mk_norm_expr offsets expr (Expr_fby (norm_e1, norm_e2)) in 
259 
mk_expr_alias_opt alias node defvars norm_expr 
260 
 Expr_when (e, c, l) > 
261 
let defvars, norm_e = normalize_expr node offsets defvars e in 
262 
defvars, mk_norm_expr offsets expr (Expr_when (norm_e, c, l)) 
263 
 Expr_ite (c, t, e) > 
264 
let defvars, norm_c = normalize_guard node defvars c in 
265 
let defvars, norm_t = normalize_cond_expr node offsets defvars t in 
266 
let defvars, norm_e = normalize_cond_expr node offsets defvars e in 
267 
let norm_expr = mk_norm_expr offsets expr (Expr_ite (norm_c, norm_t, norm_e)) in 
268 
mk_expr_alias_opt alias node defvars norm_expr 
269 
 Expr_merge (c, hl) > 
270 
let defvars, norm_hl = normalize_branches node offsets defvars hl in 
271 
let norm_expr = mk_norm_expr offsets expr (Expr_merge (c, norm_hl)) in 
272 
mk_expr_alias_opt alias node defvars norm_expr 
273  
274 
(* Creates a conditional with a merge construct, which is more lazy *) 
275 
(* 
276 
let norm_conditional_as_merge alias node norm_expr offsets defvars expr = 
277 
match expr.expr_desc with 
278 
 Expr_ite (c, t, e) > 
279 
let defvars, norm_t = norm_expr (alias node offsets defvars t in 
280 
 _ > assert false 
281 
*) 
282 
and normalize_branches node offsets defvars hl = 
283 
List.fold_right 
284 
(fun (t, h) (defvars, norm_q) > 
285 
let (defvars, norm_h) = normalize_cond_expr node offsets defvars h in 
286 
defvars, (t, norm_h) :: norm_q 
287 
) 
288 
hl (defvars, []) 
289  
290 
and normalize_array_expr ?(alias=true) node offsets defvars expr = 
291 
(*Format.eprintf "normalize_array %B %a [%a]@." alias Printers.pp_expr expr (Utils.fprintf_list ~sep:"," Dimension.pp_dimension) offsets;*) 
292 
match expr.expr_desc with 
293 
 Expr_power (e1, d) when offsets = [] > 
294 
let defvars, norm_e1 = normalize_expr node offsets defvars e1 in 
295 
defvars, mk_norm_expr offsets expr (Expr_power (norm_e1, d)) 
296 
 Expr_power (e1, d) > 
297 
normalize_array_expr ~alias:alias node (List.tl offsets) defvars e1 
298 
 Expr_access (e1, d) > normalize_array_expr ~alias:alias node (d::offsets) defvars e1 
299 
 Expr_array elist when offsets = [] > 
300 
let defvars, norm_elist = normalize_list alias node offsets (fun _ > normalize_array_expr ~alias:true) defvars elist in 
301 
defvars, mk_norm_expr offsets expr (Expr_array norm_elist) 
302 
 Expr_appl (id, args, None) when Basic_library.is_expr_internal_fun expr > 
303 
let defvars, norm_args = normalize_list alias node offsets (fun _ > normalize_array_expr ~alias:true) defvars (expr_list_of_expr args) in 
304 
defvars, mk_norm_expr offsets expr (Expr_appl (id, expr_of_expr_list args.expr_loc norm_args, None)) 
305 
 _ > normalize_expr ~alias:alias node offsets defvars expr 
306  
307 
and normalize_cond_expr ?(alias=true) node offsets defvars expr = 
308 
(*Format.eprintf "normalize_cond %B %a [%a]@." alias Printers.pp_expr expr (Utils.fprintf_list ~sep:"," Dimension.pp_dimension) offsets;*) 
309 
match expr.expr_desc with 
310 
 Expr_access (e1, d) > 
311 
normalize_cond_expr ~alias:alias node (d::offsets) defvars e1 
312 
 Expr_ite (c, t, e) > 
313 
let defvars, norm_c = normalize_guard node defvars c in 
314 
let defvars, norm_t = normalize_cond_expr node offsets defvars t in 
315 
let defvars, norm_e = normalize_cond_expr node offsets defvars e in 
316 
defvars, mk_norm_expr offsets expr (Expr_ite (norm_c, norm_t, norm_e)) 
317 
 Expr_merge (c, hl) > 
318 
let defvars, norm_hl = normalize_branches node offsets defvars hl in 
319 
defvars, mk_norm_expr offsets expr (Expr_merge (c, norm_hl)) 
320 
 _ when !force_alias_ite > 
321 
(* Forcing alias creation for then/else expressions *) 
322 
let defvars, norm_expr = 
323 
normalize_expr ~alias:alias node offsets defvars expr 
324 
in 
325 
mk_expr_alias_opt true node defvars norm_expr 
326 
 _ > (* default case without the force_alias_ite option *) 
327 
normalize_expr ~alias:alias node offsets defvars expr 
328 

329 
and normalize_guard node defvars expr = 
330 
let defvars, norm_expr = normalize_expr node [] defvars expr in 
331 
mk_expr_alias_opt true node defvars norm_expr 
332  
333 
(* outputs cannot be memories as well. If so, introduce new local variable. 
334 
*) 
335 
let decouple_outputs node defvars eq = 
336 
let rec fold_lhs defvars lhs tys cks = 
337 
match lhs, tys, cks with 
338 
 [], [], [] > defvars, [] 
339 
 v::qv, t::qt, c::qc > let (defs_q, vars_q), lhs_q = fold_lhs defvars qv qt qc in 
340 
if List.exists (fun o > o.var_id = v) node.node_outputs 
341 
then 
342 
let newvar = mk_fresh_var node eq.eq_loc t c in 
343 
let neweq = mkeq eq.eq_loc ([v], expr_of_vdecl newvar) in 
344 
(neweq :: defs_q, newvar :: vars_q), newvar.var_id :: lhs_q 
345 
else 
346 
(defs_q, vars_q), v::lhs_q 
347 
 _ > assert false in 
348 
let defvars', lhs' = 
349 
fold_lhs 
350 
defvars 
351 
eq.eq_lhs 
352 
(Types.type_list_of_type eq.eq_rhs.expr_type) 
353 
(Clocks.clock_list_of_clock eq.eq_rhs.expr_clock) in 
354 
defvars', {eq with eq_lhs = lhs' } 
355  
356 
let rec normalize_eq node defvars eq = 
357 
(*Format.eprintf "normalize_eq %a@." Types.print_ty eq.eq_rhs.expr_type;*) 
358 
match eq.eq_rhs.expr_desc with 
359 
 Expr_pre _ 
360 
 Expr_fby _ > 
361 
let (defvars', eq') = decouple_outputs node defvars eq in 
362 
let (defs', vars'), norm_rhs = normalize_expr ~alias:false node [] defvars' eq'.eq_rhs in 
363 
let norm_eq = { eq' with eq_rhs = norm_rhs } in 
364 
(norm_eq::defs', vars') 
365 
 Expr_array _ > 
366 
let (defs', vars'), norm_rhs = normalize_array_expr ~alias:false node [] defvars eq.eq_rhs in 
367 
let norm_eq = { eq with eq_rhs = norm_rhs } in 
368 
(norm_eq::defs', vars') 
369 
 Expr_appl (id, _, None) when Basic_library.is_homomorphic_fun id && Types.is_array_type eq.eq_rhs.expr_type > 
370 
let (defs', vars'), norm_rhs = normalize_array_expr ~alias:false node [] defvars eq.eq_rhs in 
371 
let norm_eq = { eq with eq_rhs = norm_rhs } in 
372 
(norm_eq::defs', vars') 
373 
 Expr_appl _ > 
374 
let (defs', vars'), norm_rhs = normalize_expr ~alias:false node [] defvars eq.eq_rhs in 
375 
let norm_eq = { eq with eq_rhs = norm_rhs } in 
376 
(norm_eq::defs', vars') 
377 
 _ > 
378 
let (defs', vars'), norm_rhs = normalize_cond_expr ~alias:false node [] defvars eq.eq_rhs in 
379 
let norm_eq = { eq with eq_rhs = norm_rhs } in 
380 
norm_eq::defs', vars' 
381  
382 
(** normalize_node node returns a normalized node, 
383 
ie. 
384 
 updated locals 
385 
 new equations 
386 
 
387 
*) 
388 
let normalize_node node = 
389 
cpt_fresh := 0; 
390 
let inputs_outputs = node.node_inputs@node.node_outputs in 
391 
let is_local v = 
392 
List.for_all ((!=) v) inputs_outputs in 
393 
let orig_vars = inputs_outputs@node.node_locals in 
394 
let defs, vars = 
395 
List.fold_left (normalize_eq node) ([], orig_vars) (get_node_eqs node) in 
396 
(* Normalize the asserts *) 
397 
let vars, assert_defs, asserts = 
398 
List.fold_left ( 
399 
fun (vars, def_accu, assert_accu) assert_ > 
400 
let assert_expr = assert_.assert_expr in 
401 
let (defs, vars'), expr = 
402 
normalize_expr 
403 
~alias:true (* forcing introduction of new equations for fcn calls *) 
404 
node 
405 
[] (* empty offset for arrays *) 
406 
([], vars) (* defvar only contains vars *) 
407 
assert_expr 
408 
in 
409 
(*Format.eprintf "New assert vars: %a@.@?" (fprintf_list ~sep:", " Printers.pp_var) vars';*) 
410 
vars', defs@def_accu, {assert_ with assert_expr = expr}::assert_accu 
411 
) (vars, [], []) node.node_asserts in 
412 
let new_locals = List.filter is_local vars in 
413 
(*Format.eprintf "New locals: %a@.@?" (fprintf_list ~sep:", " Printers.pp_var) new_locals;*) 
414  
415 
let new_annots = 
416 
if !Options.traces then 
417 
begin 
418 
(* Compute traceability info: 
419 
 gather newly bound variables 
420 
 compute the associated expression without aliases 
421 
*) 
422 
let diff_vars = List.filter (fun v > not (List.mem v node.node_locals) ) new_locals in 
423 
let norm_traceability = { 
424 
annots = List.map (fun v > 
425 
let eq = 
426 
try 
427 
List.find (fun eq > List.exists (fun v' > v' = v.var_id ) eq.eq_lhs) (defs@assert_defs) 
428 
with Not_found > 
429 
( 
430 
Format.eprintf "Traceability annotation generation: var %s not found@." v.var_id; 
431 
assert false 
432 
) 
433 
in 
434 
let expr = substitute_expr diff_vars (defs@assert_defs) eq.eq_rhs in 
435 
let pair = mkeexpr expr.expr_loc (mkexpr expr.expr_loc (Expr_tuple [expr_of_ident v.var_id expr.expr_loc; expr])) in 
436 
(["traceability"], pair) 
437 
) diff_vars; 
438 
annot_loc = Location.dummy_loc 
439 
} 
440 
in 
441 
norm_traceability::node.node_annot 
442 
end 
443 
else 
444 
node.node_annot 
445 
in 
446  
447 
let node = 
448 
{ node with 
449 
node_locals = new_locals; 
450 
node_stmts = List.map (fun eq > Eq eq) (defs @ assert_defs); 
451 
node_asserts = asserts; 
452 
node_annot = new_annots; 
453 
} 
454 
in ((*Printers.pp_node Format.err_formatter node;*) 
455 
node 
456 
) 
457  
458  
459 
let normalize_decl decl = 
460 
match decl.top_decl_desc with 
461 
 Node nd > 
462 
let decl' = {decl with top_decl_desc = Node (normalize_node nd)} in 
463 
Hashtbl.replace Corelang.node_table nd.node_id decl'; 
464 
decl' 
465 
 Open _  ImportedNode _  Const _  TypeDef _ > decl 
466  
467 
let normalize_prog ?(backend="C") decls = 
468 
let old_unfold_arrow_active = !unfold_arrow_active in 
469 
let old_force_alias_ite = !force_alias_ite in 
470 
let old_force_alias_internal_fun = !force_alias_internal_fun in 
471 

472 
(* Backend specific configurations for normalization *) 
473 
let _ = 
474 
match backend with 
475 
 "lustre" > 
476 
(* Special treatment of arrows in lustre backend. We want to keep them *) 
477 
unfold_arrow_active := false; 
478 
 "emf" > ( 
479 
(* Forcing ite normalization *) 
480 
force_alias_ite := true; 
481 
force_alias_internal_fun := true; 
482 
) 
483 
 _ > () (* No fancy options for other backends *) 
484 
in 
485  
486 
(* Main algorithm: iterates over nodes *) 
487 
let res = List.map normalize_decl decls in 
488 

489 
(* Restoring previous settings *) 
490 
unfold_arrow_active := old_unfold_arrow_active; 
491 
force_alias_ite := old_force_alias_ite; 
492 
force_alias_internal_fun := old_force_alias_internal_fun; 
493 
res 
494 

495 
(* Local Variables: *) 
496 
(* compilecommand:"make C .." *) 
497 
(* End: *) 