Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / optimize_machine.ml @ a1daa793

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 sub-expression 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 sub-expression 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 sub-expression 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
(* compile-command:"make -C .." *)
527
(* End: *)