Revision 60fbbbd9
Added by PierreLoïc Garoche about 2 years ago
src/optimize_machine.ml  

208  208 
(* Simple cases*) 
209  209 
 MStep([v], id, vl) when Basic_library.is_value_internal_fun (mk_val (Fun (id, vl)) v.var_type) 
210  210 
> instr_unfold m fanin instrs elim (update_instr_desc instr (MLocalAssign (v, mk_val (Fun (id, vl)) v.var_type))) 
211 
 MLocalAssign(v, expr) when unfoldable_assign fanin v expr 

212 
> 

211 
 MLocalAssign(v, expr) when not (is_clock_dec_type v.var_dec_type.ty_dec_desc) && unfoldable_assign fanin v expr


212 
> (* we don't eliminate clock definitions *)


213  213 
let new_eq = 
214  214 
Corelang.mkeq 
215  215 
(desome instr.lustre_eq).eq_loc 
...  ...  
245  245 

246  246 
*) 
247  247 
let machine_unfold fanin elim machine = 
248 
(*Log.report ~level:1 (fun fmt > Format.fprintf fmt "machine_unfold %a@." pp_elim elim);*)


248 
Log.report ~level:3 (fun fmt > Format.fprintf fmt "machine_unfold %s %a@." machine.mname.node_id (pp_elim machine) (IMap.map fst elim));


249  249 
let elim_consts, mconst = instrs_unfold machine fanin elim machine.mconst in 
250  250 
let elim_vars, instrs = instrs_unfold machine fanin elim_consts machine.mstep.step_instrs in 
251  251 
let instrs = simplify_instrs_offset machine instrs in 
...  ...  
276  276  
277  277 
let instr_of_const top_const = 
278  278 
let const = const_of_top top_const in 
279 
let vdecl = mkvar_decl Location.dummy_loc (const.const_id, mktyp Location.dummy_loc Tydec_any, mkclock Location.dummy_loc Ckdec_any, true, None, None) in 

280 
let vdecl = { vdecl with var_type = const.const_type } 

281 
in mkinstr (MLocalAssign (vdecl, mk_val (Cst const.const_value) vdecl.var_type)) 

279 
let loc = const.const_loc in 

280 
let id = const.const_id in 

281 
let vdecl = mkvar_decl loc (id, mktyp Location.dummy_loc Tydec_any, mkclock loc Ckdec_any, true, None, None) in 

282 
let vdecl = { vdecl with var_type = const.const_type } in 

283 
let lustre_eq = mkeq loc ([const.const_id], mkexpr loc (Expr_const const.const_value)) in 

284 
mkinstr 

285 
~lustre_eq:lustre_eq 

286 
(MLocalAssign (vdecl, mk_val (Cst const.const_value) vdecl.var_type)) 

282  287  
283  288 
(* We do not perform this optimization on contract nodes since there 
284  289 
is not explicit dependence btw variables and their use in 
...  ...  
288  293 
let is_contract = match m.mspec with Some (Contract _) > true  _ > false in 
289  294 
if is_contract then 
290  295 
m::machines, removed 
291 
else 

296 
else


292  297 
let fanin = (IMap.find m.mname.node_id node_schs).Scheduling_type.fanin_table in 
293  298 
let elim_consts, _ = instrs_unfold m fanin IMap.empty (List.map instr_of_const consts) in 
294  299 
let (m, removed_m) = machine_unfold fanin elim_consts m in 
...  ...  
346  351 
Then substitute this expression with the first assigned var 
347  352 
*) 
348  353 
let subst_instr m subst instrs instr = 
349 
(*Format.eprintf "subst instr: %a@." Machine_code.pp_instr instr;*)


354 
(* Format.eprintf "subst instr: %a@." (pp_instr m) instr; *)


350  355 
let instr = eliminate m subst instr in 
351  356 
let instr_v = get_assign_lhs instr in 
352  357 
let instr_e = get_assign_rhs instr in 
...  ...  
614  619 
let vars_to_replace, defs = (* Recovering vid from node locals *) 
615  620 
IMap.fold (fun v (_,eq) (accu_locals, accu_defs) > 
616  621 
let locals = 
617 
(List.find (fun v' > v'.var_id = v) nd.node_locals)::accu_locals in 

622 
try 

623 
(List.find (fun v' > v'.var_id = v) nd.node_locals)::accu_locals 

624 
with Not_found > accu_locals (* Variable v shall 

625 
be a global 

626 
constant, we do no 

627 
need to eliminate 

628 
it from the locals 

629 
*) 

630 
in 

618  631 
(* xxx let new_eq = { eq_lhs = [v]; eq_rhs = e; eq_loc = e.expr_loc } in *) 
619  632 
let defs = eq::accu_defs in 
620  633 
locals, defs 
...  ...  
697  710 
".. machines optimization: const. inlining (partial eval. with const)@,"); 
698  711 
let machine_code, removed_table = 
699  712 
machines_unfold (Corelang.get_consts prog) node_schs machine_code in 
700 
Log.report ~level:3


713 
Log.report ~level:3


701  714 
(fun fmt > 
702  715 
Format.fprintf fmt "\t@[Eliminated flows: @[%a@]@]@ " 
703  716 
(pp_imap (fun fmt m > pp_elim empty_machine fmt (IMap.map fst m))) removed_table); 
Also available in: Unified diff
Optimize_machine
 Constants were improperly unfolded
 Do not unfold clock definition