Revision 89137ae1 src/optimize_machine.ml
src/optimize_machine.ml  

53  53 
let eliminate_dim elim dim = 
54  54 
Dimension.expr_replace_expr (fun v > try dimension_of_value (IMap.find v elim) with Not_found > mkdim_ident dim.dim_loc v) dim 
55  55  
56 
let unfold_expr_offset m offset expr = 

57 
List.fold_left (fun res > (function Index i > Access(res, value_of_dimension m i)  Field f > failwith "not yet implemented")) expr offset 

58  
59 
let rec simplify_cst_expr m offset cst = 

60 
match offset, cst with 

61 
 [] , _ 

62 
> Cst cst 

63 
 Index i :: q, Const_array cl when Dimension.is_dimension_const i 

64 
> simplify_cst_expr m q (List.nth cl (Dimension.size_const_dimension i)) 

65 
 Index i :: q, Const_array cl 

66 
> unfold_expr_offset m [Index i] (Array (List.map (simplify_cst_expr m q) cl)) 

67 
 Field f :: q, Const_struct fl 

68 
> simplify_cst_expr m q (List.assoc f fl) 

69 
 _ > (Format.eprintf "internal error: Optimize_machine.simplify_cst_expr %a@." Printers.pp_const cst; assert false) 

70  
71 
let simplify_expr_offset m expr = 

72 
let rec simplify offset expr = 

73 
match offset, expr with 

74 
 Field f ::q , _ > failwith "not yet implemented" 

75 
 _ , Fun (id, vl) when Basic_library.is_internal_fun id 

76 
> Fun (id, List.map (simplify offset) vl) 

77 
 _ , Fun _ 

78 
 _ , StateVar _ 

79 
 _ , LocalVar _ > unfold_expr_offset m offset expr 

80 
 _ , Cst cst > simplify_cst_expr m offset cst 

81 
 _ , Access (expr, i) > simplify (Index (dimension_of_value i) :: offset) expr 

82 
 [] , _ > expr 

83 
 Index _ :: q, Power (expr, _) > simplify q expr 

84 
 Index i :: q, Array vl when Dimension.is_dimension_const i 

85 
> simplify q (List.nth vl (Dimension.size_const_dimension i)) 

86 
 Index i :: q, Array vl > unfold_expr_offset m [Index i] (Array (List.map (simplify q) vl)) 

87 
 _ > (Format.eprintf "internal error: Optimize_machine.simplify_expr_offset %a@." pp_val expr; assert false) 

88 
(*Format.eprintf "simplify_expr %a %a = %a@." pp_val expr (Utils.fprintf_list ~sep:"" Printers.pp_offset) offset pp_val res; res) 

89 
with e > (Format.eprintf "simplify_expr %a %a = <FAIL>@." pp_val expr (Utils.fprintf_list ~sep:"" Printers.pp_offset) offset; raise e*) 

90 
in simplify [] expr 

91  
92 
let rec simplify_instr_offset m instr = 

93 
match instr with 

94 
 MLocalAssign (v, expr) > MLocalAssign (v, simplify_expr_offset m expr) 

95 
 MStateAssign (v, expr) > MStateAssign (v, simplify_expr_offset m expr) 

96 
 MReset id > instr 

97 
 MStep (outputs, id, inputs) > MStep (outputs, id, List.map (simplify_expr_offset m) inputs) 

98 
 MBranch (cond, brl) 

99 
> MBranch(simplify_expr_offset m cond, List.map (fun (l, il) > l, simplify_instrs_offset m il) brl) 

100  
101 
and simplify_instrs_offset m instrs = 

102 
List.map (simplify_instr_offset m) instrs 

103  
56  104 
let is_scalar_const c = 
57  105 
match c with 
58  106 
 Const_int _ 
...  ...  
61  109 
 Const_tag _ > true 
62  110 
 _ > false 
63  111  
64 
let basic_unfoldable_expr expr = 

65 
match expr with 

66 
 Cst c when is_scalar_const c > true 

67 
 LocalVar _ 

68 
 StateVar _ > true 

69 
 _ > false 

112 
(* An instruction v = expr may (and will) be unfolded iff: 

113 
 either expr is atomic 

114 
(no complex expressions, only const, vars and array/struct accesses) 

115 
 or v has a fanin <= 1 (used at most once) 

116 
*) 

117 
let is_unfoldable_expr fanin expr = 

118 
let rec unfold_const offset cst = 

119 
match offset, cst with 

120 
 _ , Const_int _ 

121 
 _ , Const_real _ 

122 
 _ , Const_float _ 

123 
 _ , Const_tag _ > true 

124 
 Field f :: q, Const_struct fl > unfold_const q (List.assoc f fl) 

125 
 [] , Const_struct _ > false 

126 
 Index i :: q, Const_array cl when Dimension.is_dimension_const i 

127 
> unfold_const q (List.nth cl (Dimension.size_const_dimension i)) 

128 
 _ , Const_array _ > false 

129 
 _ > assert false in 

130 
let rec unfold offset expr = 

131 
match offset, expr with 

132 
 _ , Cst cst > unfold_const offset cst 

133 
 _ , LocalVar _ 

134 
 _ , StateVar _ > true 

135 
 [] , Power _ 

136 
 [] , Array _ > false 

137 
 Index i :: q, Power (v, _) > unfold q v 

138 
 Index i :: q, Array vl when Dimension.is_dimension_const i 

139 
> unfold q (List.nth vl (Dimension.size_const_dimension i)) 

140 
 _ , Array _ > false 

141 
 _ , Access (v, i) > unfold (Index (dimension_of_value i) :: offset) v 

142 
 _ , Fun (id, vl) when fanin < 2 && Basic_library.is_internal_fun id 

143 
> List.for_all (unfold offset) vl 

144 
 _ , Fun _ > false 

145 
 _ > assert false 

146 
in unfold [] expr 

70  147  
71  148 
let unfoldable_assign fanin v expr = 
72  149 
try 
73  150 
let d = Hashtbl.find fanin v.var_id 
74 
in basic_unfoldable_expr expr  

151 
in is_unfoldable_expr d expr 

152 
with Not_found > false 

153 
(* 

154 
let unfoldable_assign fanin v expr = 

155 
try 

156 
let d = Hashtbl.find fanin v.var_id 

157 
in is_basic_expr expr  

75  158 
match expr with 
76  159 
 Cst c when d < 2 > true 
77  160 
 Fun (id, _) when d < 2 && Basic_library.is_internal_fun id > true 
78  161 
 _ > false 
79  162 
with Not_found > false 
80  
163 
*) 

81  164 
let merge_elim elim1 elim2 = 
82  165 
let merge k e1 e2 = 
83  166 
match e1, e2 with 
...  ...  
142  225 
(*Log.report ~level:1 (fun fmt > Format.fprintf fmt "machine_unfold %a@." pp_elim elim);*) 
143  226 
let elim_consts, mconst = instrs_unfold fanin elim machine.mconst in 
144  227 
let elim_vars, instrs = instrs_unfold fanin elim_consts machine.mstep.step_instrs in 
228 
let instrs = simplify_instrs_offset machine instrs in 

229 
let checks = List.map (fun (loc, check) > loc, eliminate_expr elim_vars check) machine.mstep.step_checks in 

145  230 
let locals = List.filter (fun v > not (IMap.mem v.var_id elim_vars)) machine.mstep.step_locals in 
146  231 
let minstances = List.map (static_call_unfold elim_consts) machine.minstances in 
147  232 
let mcalls = List.map (static_call_unfold elim_consts) machine.mcalls 
...  ...  
151  236 
mstep = { 
152  237 
machine.mstep with 
153  238 
step_locals = locals; 
154 
step_instrs = instrs 

239 
step_instrs = instrs; 

240 
step_checks = checks 

155  241 
}; 
156  242 
mconst = mconst; 
157  243 
minstances = minstances; 
...  ...  
257  343 
(* Simple cases*) 
258  344 
 MStep([v], id, vl) when Basic_library.is_internal_fun id 
259  345 
> instr_cse (subst, instrs) (MLocalAssign (v, Fun (id, vl))) 
260 
 MLocalAssign(v, expr) when basic_unfoldable_expr expr


346 
 MLocalAssign(v, expr) when is_unfoldable_expr 2 expr


261  347 
> (IMap.add v.var_id expr subst, instr :: instrs) 
262  348 
 _ when is_assign instr 
263  349 
> subst_instr subst instrs instr 
Also available in: Unified diff