Revision a91680fc
Added by LĂ©lio Brun 8 months ago
src/optimize_machine.ml  

623  623 
(* Additional function to modify the prog according to removed variables map *) 
624  624  
625  625 
let elim_prog_variables prog removed_table = 
626 
List.map ( 

627 
fun t > 

628 
match t.top_decl_desc with 

629 
Node nd > 

630 
if IMap.mem nd.node_id removed_table then 

631 
let nd_elim_map = IMap.find nd.node_id removed_table in 

632 
(* Iterating through the elim map to compute 

633 
 the list of variables to remove 

634 
 the associated list of lustre definitions x = expr to 

635 
be used when removing these variables *) 

636 
let vars_to_replace, defs = (* Recovering vid from node locals *) 

637 
IMap.fold (fun v (_,eq) (accu_locals, accu_defs) > 

638 
let locals = 

639 
try 

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

641 
with Not_found > accu_locals (* Variable v shall 

642 
be a global 

643 
constant, we do no 

644 
need to eliminate 

645 
it from the locals 

646 
*) 

647 
in 

648 
(* xxx let new_eq = { eq_lhs = [v]; eq_rhs = e; eq_loc = e.expr_loc } in *) 

649 
let defs = eq::accu_defs in 

650 
locals, defs 

651 
) nd_elim_map ([], []) 

652 
in 

653 


654 
let new_locals, new_stmts = 

655 
List.fold_right (fun stmt (locals, res_stmts) > 

656 
match stmt with 

657 
Aut _ > assert false (* should be processed by now *) 

658 
 Eq eq > ( 

659 
match eq.eq_lhs with 

660 
 [] > assert false (* shall not happen *) 

661 
 _::_::_ > 

662 
(* When more than one lhs we just keep the 

663 
equation and do not delete it *) 

664 
let eq_rhs' = substitute_expr vars_to_replace defs eq.eq_rhs in 

665 
locals, (Eq { eq with eq_rhs = eq_rhs' })::res_stmts 

666 
 [lhs] > 

667 
if List.exists (fun v > v.var_id = lhs) vars_to_replace then 

668 
(* We remove the def *) 

669 
List.filter (fun l > l.var_id != lhs) locals, 

670 
res_stmts 

671 
else (* We keep it but modify any use of an eliminatend var *) 

672 
let eq_rhs' = substitute_expr vars_to_replace defs eq.eq_rhs in 

673 
locals, 

674 
(Eq { eq with eq_rhs = eq_rhs' })::res_stmts 

675 


676 
) 

677 
) nd.node_stmts (nd.node_locals,[]) 

678 
in 

679 
let nd' = { nd with 

680 
node_locals = new_locals; 

681 
node_stmts = new_stmts; 

682 
} 

683 
in 

684 
{ t with top_decl_desc = Node nd' } 

685 
else 

686 
t 

626 
List.map (fun t > match t.top_decl_desc with 

627 
 Node nd > 

628 
begin match IMap.find_opt nd.node_id removed_table with 

629 
 Some nd_elim_map > 

630 
(* Iterating through the elim map to compute 

631 
 the list of variables to remove 

632 
 the associated list of lustre definitions x = expr to 

633 
be used when removing these variables *) 

634 
let vars_to_replace, defs = (* Recovering vid from node locals *) 

635 
IMap.fold (fun v (_,eq) (accu_locals, accu_defs) > 

636 
let locals = 

637 
try 

638 
List.find (fun v' > v'.var_id = v) nd.node_locals 

639 
:: accu_locals 

640 
with Not_found > accu_locals (* Variable v shall 

641 
be a global 

642 
constant, we do no 

643 
need to eliminate 

644 
it from the locals 

645 
*) 

646 
in 

647 
(* xxx let new_eq = { eq_lhs = [v]; eq_rhs = e; eq_loc = e.expr_loc } in *) 

648 
let defs = eq::accu_defs in 

649 
locals, defs 

650 
) nd_elim_map ([], []) 

651 
in 

652  
653 
let node_locals, node_stmts = 

654 
List.fold_right (fun stmt (locals, res_stmts) > 

655 
match stmt with 

656 
 Aut _ > assert false (* should be processed by now *) 

657 
 Eq eq > 

658 
begin match eq.eq_lhs with 

659 
 [] > assert false (* shall not happen *) 

660 
 _::_::_ > 

661 
(* When more than one lhs we just keep the 

662 
equation and do not delete it *) 

663 
let eq_rhs' = substitute_expr vars_to_replace defs eq.eq_rhs in 

664 
locals, (Eq { eq with eq_rhs = eq_rhs' })::res_stmts 

665 
 [lhs] > 

666 
if List.exists (fun v > v.var_id = lhs) vars_to_replace then 

667 
(* We remove the def *) 

668 
List.filter (fun v > v.var_id <> lhs) locals, 

669 
res_stmts 

670 
else (* We keep it but modify any use of an eliminatend var *) 

671 
let eq_rhs' = substitute_expr vars_to_replace defs eq.eq_rhs in 

672 
locals, 

673 
(Eq { eq with eq_rhs = eq_rhs' })::res_stmts 

674 
end 

675 
) nd.node_stmts (nd.node_locals, []) 

676 
in 

677 
let nd' = { nd with node_locals; node_stmts } in 

678 
{ t with top_decl_desc = Node nd' } 

679 
 None > t 

680 
end 

687  681 
 _ > t 
688 
) prog


682 
) prog 

689  683  
690  684 
(*** Main function ***) 
691  685 
Also available in: Unified diff
Bug fix with constant inlining variable removal in machine code