lustrec / src / optimize_machine.ml @ 89137ae1
History  View  Annotate  Download (20.6 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 Causality 
16 
open Machine_code 
17 
open Dimension 
18  
19  
20 
let pp_elim fmt elim = 
21 
begin 
22 
Format.fprintf fmt "{ /* elim table: */@."; 
23 
IMap.iter (fun v expr > Format.fprintf fmt "%s > %a@." v pp_val expr) elim; 
24 
Format.fprintf fmt "}@."; 
25 
end 
26  
27 
let rec eliminate elim instr = 
28 
let e_expr = eliminate_expr elim in 
29 
match instr with 
30 
 MLocalAssign (i,v) > MLocalAssign (i, e_expr v) 
31 
 MStateAssign (i,v) > MStateAssign (i, e_expr v) 
32 
 MReset i > instr 
33 
 MStep (il, i, vl) > MStep(il, i, List.map e_expr vl) 
34 
 MBranch (g,hl) > 
35 
MBranch 
36 
(e_expr g, 
37 
(List.map 
38 
(fun (l, il) > l, List.map (eliminate elim) il) 
39 
hl 
40 
) 
41 
) 
42 

43 
and eliminate_expr elim expr = 
44 
match expr with 
45 
 StateVar v 
46 
 LocalVar v > (try IMap.find v.var_id elim with Not_found > expr) 
47 
 Fun (id, vl) > Fun (id, List.map (eliminate_expr elim) vl) 
48 
 Array(vl) > Array(List.map (eliminate_expr elim) vl) 
49 
 Access(v1, v2) > Access(eliminate_expr elim v1, eliminate_expr elim v2) 
50 
 Power(v1, v2) > Power(eliminate_expr elim v1, eliminate_expr elim v2) 
51 
 Cst _ > expr 
52  
53 
let eliminate_dim elim dim = 
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  
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  
104 
let is_scalar_const c = 
105 
match c with 
106 
 Const_int _ 
107 
 Const_real _ 
108 
 Const_float _ 
109 
 Const_tag _ > true 
110 
 _ > false 
111  
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 
147  
148 
let unfoldable_assign fanin v expr = 
149 
try 
150 
let d = Hashtbl.find fanin v.var_id 
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  
158 
match expr with 
159 
 Cst c when d < 2 > true 
160 
 Fun (id, _) when d < 2 && Basic_library.is_internal_fun id > true 
161 
 _ > false 
162 
with Not_found > false 
163 
*) 
164 
let merge_elim elim1 elim2 = 
165 
let merge k e1 e2 = 
166 
match e1, e2 with 
167 
 Some e1, Some e2 > if e1 = e2 then Some e1 else None 
168 
 _ , Some e2 > Some e2 
169 
 Some e1, _ > Some e1 
170 
 _ > None 
171 
in IMap.merge merge elim1 elim2 
172  
173 
(* see if elim has to take in account the provided instr: 
174 
if so, update elim and return the remove flag, 
175 
otherwise, the expression should be kept and elim is left untouched *) 
176 
let rec instrs_unfold fanin elim instrs = 
177 
let elim, rev_instrs = 
178 
List.fold_left (fun (elim, instrs) instr > 
179 
(* each subexpression in instr that could be rewritten by the elim set is 
180 
rewritten *) 
181 
let instr = eliminate elim instr in 
182 
(* if instr is a simple local assign, then (a) elim is simplified with it (b) it 
183 
is stored as the elim set *) 
184 
instr_unfold fanin instrs elim instr 
185 
) (elim, []) instrs 
186 
in elim, List.rev rev_instrs 
187  
188 
and instr_unfold fanin instrs elim instr = 
189 
(* Format.eprintf "SHOULD WE STORE THE EXPRESSION IN INSTR %a TO ELIMINATE IT@." pp_instr instr;*) 
190 
match instr with 
191 
(* Simple cases*) 
192 
 MStep([v], id, vl) when Basic_library.is_internal_fun id 
193 
> instr_unfold fanin instrs elim (MLocalAssign (v, Fun (id, vl))) 
194 
 MLocalAssign(v, expr) when unfoldable_assign fanin v expr 
195 
> (IMap.add v.var_id expr elim, instrs) 
196 
 MBranch(g, hl) when false 
197 
> let elim_branches = List.map (fun (h, l) > (h, instrs_unfold fanin elim l)) hl in 
198 
let (elim, branches) = 
199 
List.fold_right 
200 
(fun (h, (e, l)) (elim, branches) > (merge_elim elim e, (h, l)::branches)) 
201 
elim_branches (elim, []) 
202 
in elim, (MBranch (g, branches) :: instrs) 
203 
 _ 
204 
> (elim, instr :: instrs) 
205 
(* default case, we keep the instruction and do not modify elim *) 
206 

207  
208 
(** We iterate in the order, recording simple local assigns in an accumulator 
209 
1. each expression is rewritten according to the accumulator 
210 
2. local assigns then rewrite occurrences of the lhs in the computed accumulator 
211 
*) 
212  
213 
let static_call_unfold elim (inst, (n, args)) = 
214 
let replace v = 
215 
try 
216 
Machine_code.dimension_of_value (IMap.find v elim) 
217 
with Not_found > Dimension.mkdim_ident Location.dummy_loc v 
218 
in (inst, (n, List.map (Dimension.expr_replace_expr replace) args)) 
219  
220 
(** Perform optimization on machine code: 
221 
 iterate through step instructions and remove simple local assigns 
222 

223 
*) 
224 
let machine_unfold fanin elim machine = 
225 
(*Log.report ~level:1 (fun fmt > Format.fprintf fmt "machine_unfold %a@." pp_elim elim);*) 
226 
let elim_consts, mconst = instrs_unfold fanin elim machine.mconst in 
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 
230 
let locals = List.filter (fun v > not (IMap.mem v.var_id elim_vars)) machine.mstep.step_locals in 
231 
let minstances = List.map (static_call_unfold elim_consts) machine.minstances in 
232 
let mcalls = List.map (static_call_unfold elim_consts) machine.mcalls 
233 
in 
234 
{ 
235 
machine with 
236 
mstep = { 
237 
machine.mstep with 
238 
step_locals = locals; 
239 
step_instrs = instrs; 
240 
step_checks = checks 
241 
}; 
242 
mconst = mconst; 
243 
minstances = minstances; 
244 
mcalls = mcalls; 
245 
} 
246  
247 
let instr_of_const top_const = 
248 
let const = const_of_top top_const in 
249 
let vdecl = mkvar_decl Location.dummy_loc (const.const_id, mktyp Location.dummy_loc Tydec_any, mkclock Location.dummy_loc Ckdec_any, true, None) in 
250 
let vdecl = { vdecl with var_type = const.const_type } 
251 
in MLocalAssign (vdecl, Cst const.const_value) 
252  
253 
let machines_unfold consts node_schs machines = 
254 
List.map 
255 
(fun m > 
256 
let fanin = (IMap.find m.mname.node_id node_schs).Scheduling.fanin_table in 
257 
let elim_consts, _ = instrs_unfold fanin IMap.empty (List.map instr_of_const consts) 
258 
in machine_unfold fanin elim_consts m) 
259 
machines 
260  
261 
let get_assign_lhs instr = 
262 
match instr with 
263 
 MLocalAssign(v, _) > LocalVar v 
264 
 MStateAssign(v, _) > StateVar v 
265 
 _ > assert false 
266  
267 
let get_assign_rhs instr = 
268 
match instr with 
269 
 MLocalAssign(_, e) 
270 
 MStateAssign(_, e) > e 
271 
 _ > assert false 
272  
273 
let is_assign instr = 
274 
match instr with 
275 
 MLocalAssign _ 
276 
 MStateAssign _ > true 
277 
 _ > false 
278  
279 
let mk_assign v e = 
280 
match v with 
281 
 LocalVar v > MLocalAssign(v, e) 
282 
 StateVar v > MStateAssign(v, e) 
283 
 _ > assert false 
284  
285 
let rec assigns_instr instr assign = 
286 
match instr with 
287 
 MLocalAssign (i,_) 
288 
 MStateAssign (i,_) > ISet.add i assign 
289 
 MStep (ol, _, _) > List.fold_right ISet.add ol assign 
290 
 MBranch (_,hl) > List.fold_right (fun (_, il) > assigns_instrs il) hl assign 
291 
 _ > assign 
292  
293 
and assigns_instrs instrs assign = 
294 
List.fold_left (fun assign instr > assigns_instr instr assign) assign instrs 
295  
296 
(* 
297 
and substitute_expr subst expr = 
298 
match expr with 
299 
 StateVar v 
300 
 LocalVar v > (try IMap.find expr subst with Not_found > expr) 
301 
 Fun (id, vl) > Fun (id, List.map (substitute_expr subst) vl) 
302 
 Array(vl) > Array(List.map (substitute_expr subst) vl) 
303 
 Access(v1, v2) > Access(substitute_expr subst v1, substitute_expr subst v2) 
304 
 Power(v1, v2) > Power(substitute_expr subst v1, substitute_expr subst v2) 
305 
 Cst _ > expr 
306 
*) 
307 
(** Finds a substitute for [instr] in [instrs], 
308 
i.e. another instr' with the same rhs expression. 
309 
Then substitute this expression with the first assigned var 
310 
*) 
311 
let subst_instr subst instrs instr = 
312 
(*Format.eprintf "subst instr: %a@." Machine_code.pp_instr instr;*) 
313 
let instr = eliminate subst instr in 
314 
let v = get_assign_lhs instr in 
315 
let e = get_assign_rhs instr in 
316 
try 
317 
let instr' = List.find (fun instr' > is_assign instr' && get_assign_rhs instr' = e) instrs in 
318 
match v with 
319 
 LocalVar v > 
320 
IMap.add v.var_id (get_assign_lhs instr') subst, instrs 
321 
 StateVar v > 
322 
(match get_assign_lhs instr' with 
323 
 LocalVar v' > 
324 
let instr = eliminate subst (mk_assign (StateVar v) (LocalVar v')) in 
325 
subst, instr :: instrs 
326 
 StateVar v' > 
327 
let subst_v' = IMap.add v'.var_id (StateVar v) IMap.empty in 
328 
let instrs' = snd (List.fold_right (fun instr (ok, instrs) > (ok  instr = instr', if ok then instr :: instrs else if instr = instr' then instrs else eliminate subst_v' instr :: instrs)) instrs (false, [])) in 
329 
IMap.add v'.var_id (StateVar v) subst, instr :: instrs' 
330 
 _ > assert false) 
331 
 _ > assert false 
332 
with Not_found > subst, instr :: instrs 
333 

334 
(** Common subexpression elimination for machine instructions *) 
335 
(*  [subst] : hashtable from ident to (simple) definition 
336 
it is an equivalence table 
337 
 [elim] : set of eliminated variables 
338 
 [instrs] : previous instructions, which [instr] is compared against 
339 
 [instr] : current instruction, normalized by [subst] 
340 
*) 
341 
let rec instr_cse (subst, instrs) instr = 
342 
match instr with 
343 
(* Simple cases*) 
344 
 MStep([v], id, vl) when Basic_library.is_internal_fun id 
345 
> instr_cse (subst, instrs) (MLocalAssign (v, Fun (id, vl))) 
346 
 MLocalAssign(v, expr) when is_unfoldable_expr 2 expr 
347 
> (IMap.add v.var_id expr subst, instr :: instrs) 
348 
 _ when is_assign instr 
349 
> subst_instr subst instrs instr 
350 
 _ > (subst, instr :: instrs) 
351  
352 
(** Apply common subexpression elimination to a sequence of instrs 
353 
*) 
354 
let rec instrs_cse subst instrs = 
355 
let subst, rev_instrs = 
356 
List.fold_left instr_cse (subst, []) instrs 
357 
in subst, List.rev rev_instrs 
358  
359 
(** Apply common subexpression elimination to a machine 
360 
 iterate through step instructions and remove simple local assigns 
361 
*) 
362 
let machine_cse subst machine = 
363 
(*Log.report ~level:1 (fun fmt > Format.fprintf fmt "machine_cse %a@." pp_elim subst);*) 
364 
let subst, instrs = instrs_cse subst machine.mstep.step_instrs in 
365 
let assigned = assigns_instrs instrs ISet.empty 
366 
in 
367 
{ 
368 
machine with 
369 
mmemory = List.filter (fun vdecl > ISet.mem vdecl assigned) machine.mmemory; 
370 
mstep = { 
371 
machine.mstep with 
372 
step_locals = List.filter (fun vdecl > ISet.mem vdecl assigned) machine.mstep.step_locals; 
373 
step_instrs = instrs 
374 
} 
375 
} 
376  
377 
let machines_cse machines = 
378 
List.map 
379 
(machine_cse IMap.empty) 
380 
machines 
381  
382 
(* variable substitution for optimizing purposes *) 
383  
384 
(* checks whether an [instr] is skip and can be removed from program *) 
385 
let rec instr_is_skip instr = 
386 
match instr with 
387 
 MLocalAssign (i, LocalVar v) when i = v > true 
388 
 MStateAssign (i, StateVar v) when i = v > true 
389 
 MBranch (g, hl) > List.for_all (fun (_, il) > instrs_are_skip il) hl 
390 
 _ > false 
391 
and instrs_are_skip instrs = 
392 
List.for_all instr_is_skip instrs 
393  
394 
let instr_cons instr cont = 
395 
if instr_is_skip instr then cont else instr::cont 
396  
397 
let rec instr_remove_skip instr cont = 
398 
match instr with 
399 
 MLocalAssign (i, LocalVar v) when i = v > cont 
400 
 MStateAssign (i, StateVar v) when i = v > cont 
401 
 MBranch (g, hl) > MBranch (g, List.map (fun (h, il) > (h, instrs_remove_skip il [])) hl) :: cont 
402 
 _ > instr::cont 
403  
404 
and instrs_remove_skip instrs cont = 
405 
List.fold_right instr_remove_skip instrs cont 
406  
407 
let rec value_replace_var fvar value = 
408 
match value with 
409 
 Cst c > value 
410 
 LocalVar v > LocalVar (fvar v) 
411 
 StateVar v > value 
412 
 Fun (id, args) > Fun (id, List.map (value_replace_var fvar) args) 
413 
 Array vl > Array (List.map (value_replace_var fvar) vl) 
414 
 Access (t, i) > Access(value_replace_var fvar t, i) 
415 
 Power (v, n) > Power(value_replace_var fvar v, n) 
416  
417 
let rec instr_replace_var fvar instr cont = 
418 
match instr with 
419 
 MLocalAssign (i, v) > instr_cons (MLocalAssign (fvar i, value_replace_var fvar v)) cont 
420 
 MStateAssign (i, v) > instr_cons (MStateAssign (i, value_replace_var fvar v)) cont 
421 
 MReset i > instr_cons instr cont 
422 
 MStep (il, i, vl) > instr_cons (MStep (List.map fvar il, i, List.map (value_replace_var fvar) vl)) cont 
423 
 MBranch (g, hl) > instr_cons (MBranch (value_replace_var fvar g, List.map (fun (h, il) > (h, instrs_replace_var fvar il [])) hl)) cont 
424  
425 
and instrs_replace_var fvar instrs cont = 
426 
List.fold_right (instr_replace_var fvar) instrs cont 
427  
428 
let step_replace_var fvar step = 
429 
(* Some outputs may have been replaced by locals. 
430 
We then need to rename those outputs 
431 
without changing their clocks, etc *) 
432 
let outputs' = 
433 
List.map (fun o > { o with var_id = (fvar o).var_id }) step.step_outputs in 
434 
let locals' = 
435 
List.fold_left (fun res l > 
436 
let l' = fvar l in 
437 
if List.exists (fun o > o.var_id = l'.var_id) outputs' 
438 
then res 
439 
else Utils.add_cons l' res) 
440 
[] step.step_locals in 
441 
{ step with 
442 
step_checks = List.map (fun (l, v) > (l, value_replace_var fvar v)) step.step_checks; 
443 
step_outputs = outputs'; 
444 
step_locals = locals'; 
445 
step_instrs = instrs_replace_var fvar step.step_instrs []; 
446 
} 
447  
448 
let rec machine_replace_variables fvar m = 
449 
{ m with 
450 
mstep = step_replace_var fvar m.mstep 
451 
} 
452  
453 
let machine_reuse_variables m reuse = 
454 
let fvar v = 
455 
try 
456 
Hashtbl.find reuse v.var_id 
457 
with Not_found > v in 
458 
machine_replace_variables fvar m 
459  
460 
let machines_reuse_variables prog node_schs = 
461 
List.map 
462 
(fun m > 
463 
machine_reuse_variables m (Utils.IMap.find m.mname.node_id node_schs).Scheduling.reuse_table 
464 
) prog 
465  
466 
let rec instr_assign res instr = 
467 
match instr with 
468 
 MLocalAssign (i, _) > Disjunction.CISet.add i res 
469 
 MStateAssign (i, _) > Disjunction.CISet.add i res 
470 
 MBranch (g, hl) > List.fold_left (fun res (h, b) > instrs_assign res b) res hl 
471 
 MStep (il, _, _) > List.fold_right Disjunction.CISet.add il res 
472 
 _ > res 
473  
474 
and instrs_assign res instrs = 
475 
List.fold_left instr_assign res instrs 
476  
477 
let rec instr_constant_assign var instr = 
478 
match instr with 
479 
 MLocalAssign (i, Cst (Const_tag _)) 
480 
 MStateAssign (i, Cst (Const_tag _)) > i = var 
481 
 MBranch (g, hl) > List.for_all (fun (h, b) > instrs_constant_assign var b) hl 
482 
 _ > false 
483  
484 
and instrs_constant_assign var instrs = 
485 
List.fold_left (fun res i > if Disjunction.CISet.mem var (instr_assign Disjunction.CISet.empty i) then instr_constant_assign var i else res) false instrs 
486  
487 
let rec instr_reduce branches instr1 cont = 
488 
match instr1 with 
489 
 MLocalAssign (_, Cst (Const_tag c)) > instr1 :: (List.assoc c branches @ cont) 
490 
 MStateAssign (_, Cst (Const_tag c)) > instr1 :: (List.assoc c branches @ cont) 
491 
 MBranch (g, hl) > MBranch (g, List.map (fun (h, b) > (h, instrs_reduce branches b [])) hl) :: cont 
492 
 _ > instr1 :: cont 
493  
494 
and instrs_reduce branches instrs cont = 
495 
match instrs with 
496 
 [] > cont 
497 
 [i] > instr_reduce branches i cont 
498 
 i1::i2::q > i1 :: instrs_reduce branches (i2::q) cont 
499  
500 
let rec instrs_fusion instrs = 
501 
match instrs with 
502 
 [] 
503 
 [_] > 
504 
instrs 
505 
 i1::(MBranch (LocalVar v, hl))::q when instr_constant_assign v i1 > 
506 
instr_reduce (List.map (fun (h, b) > h, instrs_fusion b) hl) i1 (instrs_fusion q) 
507 
 i1::(MBranch (StateVar v, hl))::q when instr_constant_assign v i1 > 
508 
instr_reduce (List.map (fun (h, b) > h, instrs_fusion b) hl) i1 (instrs_fusion q) 
509 
 i1::i2::q > 
510 
i1 :: instrs_fusion (i2::q) 
511  
512 
let step_fusion step = 
513 
{ step with 
514 
step_instrs = instrs_fusion step.step_instrs; 
515 
} 
516  
517 
let rec machine_fusion m = 
518 
{ m with 
519 
mstep = step_fusion m.mstep 
520 
} 
521  
522 
let machines_fusion prog = 
523 
List.map machine_fusion prog 
524  
525 
(* Local Variables: *) 
526 
(* compilecommand:"make C .." *) 
527 
(* End: *) 