Project

General

Profile

Revision cf9cc6f9 src/optimize_machine.ml

View differences:

src/optimize_machine.ml
30 30
  | MLocalAssign (i,v) -> MLocalAssign (i, e_expr v)
31 31
  | MStateAssign (i,v) -> MStateAssign (i, e_expr v)
32 32
  | MReset i           -> instr
33
  | MNoReset i         -> instr
33 34
  | MStep (il, i, vl)  -> MStep(il, i, List.map e_expr vl)
34 35
  | MBranch (g,hl)     -> 
35 36
    MBranch
......
51 52
  | Cst _ -> expr
52 53

  
53 54
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
  Dimension.expr_replace_expr 
56
    (fun v -> try
57
		dimension_of_value (IMap.find v elim) 
58
      with Not_found -> mkdim_ident dim.dim_loc v) 
59
    dim
55 60

  
56 61
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
62
  List.fold_left 
63
    (fun res -> 
64
      (function Index i -> 
65
       Access(res, value_of_dimension m i) 
66
      | Field f -> failwith "not yet implemented"))
67
    expr offset
58 68

  
59 69
let rec simplify_cst_expr m offset cst =
60 70
    match offset, cst with
......
84 94
    | Index i :: q, Array vl when Dimension.is_dimension_const i
85 95
                                     -> simplify q (List.nth vl (Dimension.size_const_dimension i))
86 96
    | 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)
97
(*    | _ -> (Format.eprintf "internal error: Optimize_machine.simplify_expr_offset %a@." pp_val expr; assert false) *)
88 98
    (*Format.eprintf "simplify_expr %a %a = %a@." pp_val expr (Utils.fprintf_list ~sep:"" Printers.pp_offset) offset pp_val res; res)
89 99
     with e -> (Format.eprintf "simplify_expr %a %a = <FAIL>@." pp_val expr (Utils.fprintf_list ~sep:"" Printers.pp_offset) offset; raise e*)
90 100
  in simplify [] expr
91 101

  
92
let rec simplify_instr_offset m instr =
102
let rec simplify_instr_offset m accu instr =
93 103
  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)
104
  | MLocalAssign (v, expr) -> MLocalAssign (v, simplify_expr_offset m expr) :: accu
105
  | MStateAssign (v, expr) -> MStateAssign (v, simplify_expr_offset m expr) :: accu
106
  | MReset id              -> instr :: accu
107
  | MNoReset id              -> instr :: accu
108
  | MStep (outputs, id, inputs) -> MStep (outputs, id, List.map (simplify_expr_offset m) inputs) :: accu
98 109
  | MBranch (cond, brl)
99
    -> MBranch(simplify_expr_offset m cond, List.map (fun (l, il) -> l, simplify_instrs_offset m il) brl)
100

  
110
    -> (
111
    let cond' = simplify_expr_offset m cond in
112
    match cond' with
113
    | Cst (Const_tag l) -> 
114
      let il = List.assoc l brl in
115
      List.fold_left (simplify_instr_offset m) accu il
116
    |  _ -> MBranch(cond', List.map (fun (l, il) -> l, simplify_instrs_offset m il) brl) :: accu
117
    )
101 118
and simplify_instrs_offset m instrs =
102
  List.map (simplify_instr_offset m) instrs
119
  let rev_l = List.fold_left (simplify_instr_offset m) [] instrs in
120
  List.rev rev_l
103 121

  
104 122
let is_scalar_const c =
105 123
  match c with
......
219 237

  
220 238
(** Perform optimization on machine code:
221 239
    - iterate through step instructions and remove simple local assigns
222
    
240
    - constant switch cases are simplified
223 241
*)
224 242
let machine_unfold fanin elim machine =
225 243
  (*Log.report ~level:1 (fun fmt -> Format.fprintf fmt "machine_unfold %a@." pp_elim elim);*)
......
419 437
  | MLocalAssign (i, v) -> instr_cons (MLocalAssign (fvar i, value_replace_var fvar v)) cont
420 438
  | MStateAssign (i, v) -> instr_cons (MStateAssign (i, value_replace_var fvar v)) cont
421 439
  | MReset i            -> instr_cons instr cont
440
  | MNoReset i            -> instr_cons instr cont
422 441
  | MStep (il, i, vl)   -> instr_cons (MStep (List.map fvar il, i, List.map (value_replace_var fvar) vl)) cont
423 442
  | 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 443

  

Also available in: Unified diff