Revision 307aba8d src/optimize_machine.ml
src/optimize_machine.ml  

9  9 
(* *) 
10  10 
(********************************************************************) 
11  11  
12 
open Utils 

12  13 
open LustreSpec 
13  14 
open Corelang 
14  15 
open Causality 
15  16 
open Machine_code 
16  17  
18 
let pp_elim fmt elim = 

19 
begin 

20 
Format.fprintf fmt "{ /* elim table: */@."; 

21 
IMap.iter (fun v expr > Format.fprintf fmt "%s > %a@." v pp_val expr) elim; 

22 
Format.fprintf fmt "}@."; 

23 
end 

24  
17  25 
let rec eliminate elim instr = 
18  26 
let e_expr = eliminate_expr elim in 
19  27 
match instr with 
...  ...  
32  40 

33  41 
and eliminate_expr elim expr = 
34  42 
match expr with 
35 
 LocalVar v > if List.mem_assoc v elim then List.assoc v elim else expr


43 
 LocalVar v > (try IMap.find v.var_id elim with Not_found > expr)


36  44 
 Fun (id, vl) > Fun (id, List.map (eliminate_expr elim) vl) 
37  45 
 Array(vl) > Array(List.map (eliminate_expr elim) vl) 
38  46 
 Access(v1, v2) > Access(eliminate_expr elim v1, eliminate_expr elim v2) 
39 
 Power(v1, v2) > Access(eliminate_expr elim v1, eliminate_expr elim v2)


47 
 Power(v1, v2) > Power(eliminate_expr elim v1, eliminate_expr elim v2)


40  48 
 Cst _  StateVar _ > expr 
41  49  
50 
let is_scalar_const c = 

51 
match c with 

52 
 Const_int _ 

53 
 Const_real _ 

54 
 Const_float _ 

55 
 Const_tag _ > true 

56 
 _ > false 

57  
58 
let unfoldable_assign fanin v expr = 

59 
try 

60 
let d = Hashtbl.find fanin v.var_id 

61 
in match expr with 

62 
 Cst c when is_scalar_const c > true 

63 
 Cst c when d < 2 > true 

64 
 LocalVar _ 

65 
 StateVar _ > true 

66 
 Fun (id, _) when d < 2 && Basic_library.is_internal_fun id > true 

67 
 _ > false 

68 
with Not_found > false 

69  
70 
let merge_elim elim1 elim2 = 

71 
let merge k e1 e2 = 

72 
match e1, e2 with 

73 
 Some e1, Some e2 > if e1 = e2 then Some e1 else None 

74 
 _ , Some e2 > Some e2 

75 
 Some e1, _ > Some e1 

76 
 _ > None 

77 
in IMap.merge merge elim1 elim2 

78  
42  79 
(* see if elim has to take in account the provided instr: 
43  80 
if so, update elim and return the remove flag, 
44  81 
otherwise, the expression should be kept and elim is left untouched *) 
45 
let update_elim outputs elim instr = 

82 
let rec instrs_unfold fanin elim instrs = 

83 
let elim, rev_instrs = 

84 
List.fold_left (fun (elim, instrs) instr > 

85 
(* each subexpression in instr that could be rewritten by the elim set is 

86 
rewritten *) 

87 
let instr = eliminate elim instr in 

88 
(* if instr is a simple local assign, then (a) elim is simplified with it (b) it 

89 
is stored as the elim set *) 

90 
instr_unfold fanin instrs elim instr 

91 
) (elim, []) instrs 

92 
in elim, List.rev rev_instrs 

93  
94 
and instr_unfold fanin instrs elim instr = 

46  95 
(* Format.eprintf "SHOULD WE STORE THE EXPRESSION IN INSTR %a TO ELIMINATE IT@." pp_instr instr;*) 
47 


48 
let apply elim v new_e = 

49 
(v, new_e)::List.map (fun (v, e) > v, eliminate_expr [v, new_e] e) elim 

50 
in 

51  96 
match instr with 
52  97 
(* Simple cases*) 
53 
 MLocalAssign (v, (Cst _ as e)) 

54 
 MLocalAssign (v, (LocalVar _ as e)) 

55 
 MLocalAssign (v, (StateVar _ as e)) > 

56 
if not (List.mem v outputs) then true, apply elim v e else false, elim 

57 
(* When optimization >= 3, we also inline any basic operator call. 

58 
All those are returning a single ouput *) 

59 
 MStep([v], id, vl) when 

60 
Basic_library.is_internal_fun id 

61 
&& !Options.optimization >= 3 

62 
> assert false 

63 
(* true, apply elim v (Fun(id, vl))*) 

64  
65 


66 
 MLocalAssign (v, ((Fun (id, il)) as e)) when 

67 
not (List.mem v outputs) 

68 
&& Basic_library.is_internal_fun id (* this will avoid inlining ite *) 

69 
&& !Options.optimization >= 3 

70 
> ( 

71 
(* Format.eprintf "WE STORE THE EXPRESSION DEFINING %s TO ELIMINATE IT@." v.var_id; *) 

72 
true, apply elim v e 

73 
) 

74 
 _ > 

98 
 MStep([v], id, vl) when Basic_library.is_internal_fun id 

99 
> instr_unfold fanin instrs elim (MLocalAssign (v, Fun (id, vl))) 

100 
 MLocalAssign(v, expr) when unfoldable_assign fanin v expr 

101 
> (IMap.add v.var_id expr elim, instrs) 

102 
 MBranch(g, hl) when false 

103 
> let elim_branches = List.map (fun (h, l) > (h, instrs_unfold fanin elim l)) hl in 

104 
let (elim, branches) = 

105 
List.fold_right 

106 
(fun (h, (e, l)) (elim, branches) > (merge_elim elim e, (h, l)::branches)) 

107 
elim_branches (elim, []) 

108 
in elim, (MBranch (g, branches) :: instrs) 

109 
 _ 

110 
> (elim, instr :: instrs) 

75  111 
(* default case, we keep the instruction and do not modify elim *) 
76 
false, elim 

77  112 

78  113  
79  114 
(** We iterate in the order, recording simple local assigns in an accumulator 
80  115 
1. each expression is rewritten according to the accumulator 
81  116 
2. local assigns then rewrite occurrences of the lhs in the computed accumulator 
82  117 
*) 
83 
let optimize_minstrs outputs instrs = 

84 
let rev_instrs, eliminate = 

85 
List.fold_left (fun (rinstrs, elim) instr > 

86 
(* each subexpression in instr that could be rewritten by the elim set is 

87 
rewritten *) 

88 
let instr = eliminate elim instr in 

89 
(* if instr is a simple local assign, then (a) elim is simplified with it (b) it 

90 
is stored as the elim set *) 

91 
let remove, elim = update_elim outputs elim instr in 

92 
(if remove then rinstrs else instr::rinstrs), elim 

93 
) ([],[]) instrs 

94 
in 

95 
let eliminated_vars = List.map fst eliminate in 

96 
eliminated_vars, List.rev rev_instrs 

97  118  
98  119 
(** Perform optimization on machine code: 
99  120 
 iterate through step instructions and remove simple local assigns 
100  121 

101  122 
*) 
102 
let optimize_machine machine =


103 
let eliminated_vars, new_instrs = optimize_minstrs machine.mstep.step_outputs machine.mstep.step_instrs in


104 
let new_locals =


105 
List.filter (fun v > not (List.mem v eliminated_vars)) machine.mstep.step_locals


123 
let machine_unfold fanin elim machine =


124 
(*Log.report ~level:1 (fun fmt > Format.fprintf fmt "machine_unfold %a@." pp_elim elim);*)


125 
let eliminated_vars, new_instrs = instrs_unfold fanin elim machine.mstep.step_instrs in


126 
let new_locals = List.filter (fun v > not (IMap.mem v.var_id eliminated_vars)) machine.mstep.step_locals


106  127 
in 
107  128 
{ 
108  129 
machine with 
...  ...  
112  133 
step_instrs = new_instrs 
113  134 
} 
114  135 
} 
115 


116  136  
137 
let instr_of_const top_const = 

138 
let const = const_of_top top_const in 

139 
let vdecl = mkvar_decl Location.dummy_loc (const.const_id, mktyp Location.dummy_loc Tydec_any, mkclock Location.dummy_loc Ckdec_any, true) in 

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

141 
in MLocalAssign (vdecl, Cst const.const_value) 

117  142  
118 
let optimize_machines machines = 

119 
List.map optimize_machine machines 

143 
let machines_unfold consts node_schs machines = 

144 
List.map 

145 
(fun m > 

146 
let fanin = (IMap.find m.mname.node_id node_schs).Scheduling.fanin_table in 

147 
let elim_consts, _ = instrs_unfold fanin IMap.empty (List.map instr_of_const consts) 

148 
in machine_unfold fanin elim_consts m) 

149 
machines 

120  150  
121  151 
(* variable substitution for optimizing purposes *) 
122  152 
Also available in: Unified diff