Project

General

Profile

Revision 89137ae1 src/optimize_machine.ml

View differences:

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