Project

General

Profile

Revision 61df3cb9 src/plugins/salsa/machine_salsa_opt.ml

View differences:

src/plugins/salsa/machine_salsa_opt.ml
6 6

  
7 7
(* Datatype for Salsa: FormalEnv, Ranges, Var set ... *)
8 8
open SalsaDatatypes
9
   
10
let report = Log.report ~plugins:"[salsa]" ~verbose_level:Salsa.Log.verbose_level 
9 11
(******************************************************************)
10 12
(* TODO Xavier: should those functions be declared more globally? *)
11 13

  
......
98 100
    let fresh_id = "toto"  in (* TODO more meaningful name *)
99 101

  
100 102
    let abstractEnv = RangesInt.to_abstract_env ranges in
101
    Format.eprintf "Launching analysis@.@?";
103
    report ~level:2 (fun fmt -> Format.fprintf fmt
104
                                  "Launching analysis: %s@ "
105
                                  (Salsa.Print.printExpression e_salsa));
102 106
    let new_e_salsa, e_val = 
103 107
      Salsa.MainEPEG.transformExpression fresh_id e_salsa abstractEnv
104 108
    in
105
    Format.eprintf " Analysis done@.@?";
109
    report ~level:2 (fun fmt -> Format.fprintf fmt " Analysis done: %s@ "
110
      (Salsa.Print.printExpression new_e_salsa));
106 111

  
107 112

  
108 113
    (* (\* Debug *\) *)
......
111 116
    (*   (Salsa.Print.printExpression new_e_salsa); *)
112 117
    (* (\* Debug *\) *)
113 118
    
114
    Format.eprintf " Computing range progress@.@?";
119
    report ~level:2 (fun fmt -> Format.fprintf fmt " Computing range progress@ ");
115 120

  
116 121
    let old_val = Salsa.Analyzer.evalExpr e_salsa abstractEnv [] in
117 122
    let expr, expr_range  =
118 123
      match RangesInt.Value.leq old_val e_val, RangesInt.Value.leq e_val old_val with
119 124
      | true, true -> (
120
	if !debug then Log.report ~level:2 (fun fmt ->
125
	if !debug then report ~level:2 (fun fmt ->
121 126
	  Format.fprintf fmt "No improvement on abstract value %a@ " RangesInt.pp_val e_val;
122 127
	);
123 128
	e_salsa, Some old_val
124 129
      )
125 130
      | false, true -> (
126
	if !debug then Log.report ~level:2 (fun fmt ->
131
	if !debug then report ~level:2 (fun fmt ->
127 132
	  Format.fprintf fmt "Improved!@ ";
128 133
	);
129 134
	new_e_salsa, Some e_val
130 135
      )
131
      | true, false -> Format.eprintf "CAREFUL --- new range is worse!. Restoring provided expression@ "; 	e_salsa, Some old_val
136
      | true, false ->
137
         report ~level:2 (fun fmt ->
138
             Format.fprintf fmt
139
               "CAREFUL --- new range is worse!. Restoring provided expression@ ");
140
 	     e_salsa, Some old_val
132 141

  
133 142
      | false, false -> (
134
	Format.eprintf
135
	  "Error; new range is not comparabe with old end. It may need some investigation!@.@?";
136
	Format.eprintf "old: %a@.new: %a@.@?"
137
	  RangesInt.pp_val old_val
138
	  RangesInt.pp_val e_val;
143
        report ~level:2 (fun fmt ->
144
            Format.fprintf fmt
145
	      "Error; new range is not comparable with old end. It may need some investigation!@. ";
146
	    Format.fprintf fmt "old: %a@.new: %a@ "
147
	      RangesInt.pp_val old_val
148
	      RangesInt.pp_val e_val);
139 149
	
140 150
	new_e_salsa, Some e_val
141 151
       	(* assert false *)
142 152
      )
143 153
    in
144
    Format.eprintf " Computing range done@.@?";
154
    report ~level:2 (fun fmt -> Format.fprintf fmt " Computing range done@ ");
145 155

  
146
    if !debug then Log.report ~level:2 (fun fmt ->
156
    if !debug then report ~level:2 (fun fmt ->
147 157
      Format.fprintf fmt
148 158
	"  @[<v>old_expr: @[<v 0>%s@ range: %a@]@ new_expr: @[<v 0>%s@ range: %a@]@ @]@ "
149 159
	(Salsa.Print.printExpression e_salsa)
......
156 166
    expr, expr_range
157 167
  with (* Not_found ->  *)
158 168
  | Salsa.Epeg_types.EPEGError _ -> (
159
    Log.report ~level:2 (fun fmt ->
169
    report ~level:2 (fun fmt ->
160 170
      Format.fprintf fmt
161 171
	"BECAUSE OF AN ERROR, Expression %s was not optimized@ " 	(Salsa.Print.printExpression e_salsa)
162 172
(* MC.pp_val e *));
......
180 190
       else e, None, [], Vars.empty
181 191
    | Var v -> 
182 192
       if not (Vars.mem v printed_vars) && 
183
	 (* TODO xavier: comment recuperer le type de l'expression? Parfois e.value_type vaut 'd *)
184
	 (Types.is_real_type e.value_type ||  Types.is_real_type v.LT.var_type) 
193
	    (* TODO xavier: comment recuperer le type de l'expression? Parfois e.value_type vaut 'd *)
194
	    (Types.is_real_type e.value_type ||  Types.is_real_type v.LT.var_type) 
185 195
       then
186 196
	 opt_num_expr m vars_env ranges formalEnv e 
187 197
       else 
......
198 208
	(* We do not care for computed local ranges. *)
199 209
  	let args', il, new_locals =
200 210
	  List.fold_right (
201
	    fun arg (al, il, nl) ->
211
	      fun arg (al, il, nl) ->
202 212
	      let arg', _, arg_il, arg_nl =
203 213
		opt_expr m vars_env ranges formalEnv arg in
204 214
	      arg'::al, arg_il@il, Vars.union arg_nl nl)
......
209 219
      )
210 220
    )
211 221
    | Array _
212
    | Access _
213
    | Power _ -> assert false  
222
      | Access _
223
      | Power _ -> assert false  
214 224
  and opt_num_expr m vars_env ranges formalEnv e = 
215 225
    if !debug then (
216
      Log.report ~level:2 (fun fmt -> Format.fprintf fmt "Optimizing expression @[<hov>%a@]@ "
217
	(MC.pp_val m) e);
226
      report ~level:2 (fun fmt -> Format.fprintf fmt "Optimizing expression @[<hov>%a@]@ "
227
	                            (MC.pp_val m) e);
218 228
    );
219 229
    (* if !debug then Format.eprintf "Optimizing expression %a with Salsa@ " MC.pp_val e;  *)
220 230
    (* Convert expression *)
......
259 269

  
260 270
    let free_vars = get_salsa_free_vars vars_env constEnv abstractEnv e_salsa in
261 271
    if Vars.cardinal free_vars > 0 then (
262
      Log.report ~level:2 (fun fmt -> Format.fprintf fmt
263
	"Warning: unbounded free vars (%a) in expression %a. We do not optimize it.@ " 
264
	Vars.pp (Vars.fold (fun v accu ->
265
	  let v' = {v with LT.var_id = nodename.LT.node_id ^ "." ^ v.LT.var_id } in
266
	  Vars.add v' accu)
267
		   free_vars Vars.empty)
268
	(MC.pp_val m) (salsa_expr2value_t vars_env constEnv e_salsa));
269
      if !debug then Log.report ~level:2 (fun fmt -> Format.fprintf fmt  "Some free vars, not optimizing@ ");
270
      if !debug then Log.report ~level:3 (fun fmt -> Format.fprintf fmt "  ranges: %a@ "
271
	RangesInt.pp ranges);
272
      report ~level:2 (fun fmt -> Format.fprintf fmt
273
	                                "Warning: unbounded free vars (%a) in expression %a. We do not optimize it.@ " 
274
	                                Vars.pp (Vars.fold (fun v accu ->
275
	                                             let v' = {v with LT.var_id = nodename.LT.node_id ^ "." ^ v.LT.var_id } in
276
	                                             Vars.add v' accu)
277
		                                   free_vars Vars.empty)
278
	                                (MC.pp_val m) (salsa_expr2value_t vars_env constEnv e_salsa));
279
      if !debug then report ~level:2 (fun fmt -> Format.fprintf fmt  "Some free vars, not optimizing@ ");
280
      if !debug then report ~level:3 (fun fmt -> Format.fprintf fmt "  ranges: %a@ "
281
	                                               RangesInt.pp ranges);
272 282

  
273 283
      (* if !debug then Log.report ~level:2 (fun fmt -> Format.fprintf fmt "Formal env was @[<v 0>%a@]@ " FormalEnv.pp formalEnv); *)
274 284
      
......
279 289
    else (
280 290
      
281 291
      if !debug then
282
	  Log.report ~level:3 (fun fmt -> Format.fprintf fmt "@[<v 2>Analyzing expression %a@  with ranges: @[<v>%a@ @]@ @]@ "
283
	    (C_backend_common.pp_c_val m "" (C_backend_common.pp_c_var_read m)) (salsa_expr2value_t vars_env constEnv e_salsa)
284
	    (Utils.fprintf_list ~sep:",@ "(fun fmt (l,r) -> Format.fprintf fmt "%s -> %a" l FloatIntSalsa.pp r)) abstractEnv)
285
	
292
	report ~level:3 (fun fmt -> Format.fprintf fmt "@[<v 2>Analyzing expression %a@  with ranges: @[<v>%a@ @]@ @]@ "
293
	                                  (C_backend_common.pp_c_val m "" (C_backend_common.pp_c_var_read m)) (salsa_expr2value_t vars_env constEnv e_salsa)
294
	                                  (Utils.fprintf_list ~sep:",@ "(fun fmt (l,r) -> Format.fprintf fmt "%s -> %a" l FloatIntSalsa.pp r)) abstractEnv)
295
      
286 296
      ;
287 297

  
288
      (* Slicing expression *)
289
      let e_salsa, seq =
290
	try
291
	  Salsa.Rewrite.sliceExpr e_salsa 0 (Salsa.Types.Nop(Salsa.Types.Lab 0))
292
	    with _ -> Format.eprintf "Issues rewriting express %s@.@?" (Salsa.Print.printExpression e_salsa); assert false
293
      in
294
      let def_tmps = Salsa.Utils.flatten_seq seq [] in
295
      (* Registering tmp ids in vars_env *)
296
      let vars_env', new_local_vars = List.fold_left
297
	(fun (vs,vars) (id, _) ->
298
	  let vdecl = Corelang.mk_fresh_var
299
	    nodename
300
	    Location.dummy_loc
301
	    e.MT.value_type
302
	    (Clocks.new_var true)
303
	    
304
	  in
305
	  let vs' =
306
	    VarEnv.add
307
	      id
308
	      {
309
		vdecl = vdecl ;
310
		is_local = true;
311
	      }
312
	      vs
313
	  in
314
	  let vars' = Vars.add vdecl vars in
315
	  vs', vars'
316
	)
317
	(vars_env,Vars.empty)
318
	def_tmps
319
      in 
320
      (* Debug *)
321
      if !debug then (
322
	Log.report ~level:3 (fun fmt ->
323
	  Format.fprintf  fmt "List of slices: @[<v 0>%a@]@ "
324
	    (Utils.fprintf_list
325
	       ~sep:"@ "
326
	       (fun fmt (id, e_id) ->
327
		 Format.fprintf fmt "(%s,%a) -> %a"
328
		   id
329
		   Printers.pp_var (get_var vars_env' id).vdecl
330
		   (C_backend_common.pp_c_val m "" (C_backend_common.pp_c_var_read m)) (salsa_expr2value_t vars_env' constEnv e_id)
331
	       )
332
	    )
333
	    def_tmps;
334
	  Format.eprintf "Sliced expression: %a@ "
335
	    (C_backend_common.pp_c_val m "" (C_backend_common.pp_c_var_read m)) (salsa_expr2value_t vars_env' constEnv e_salsa)
336
	  ;
298
        (* Slicing expression *)
299
        let e_salsa, seq =
300
	  try
301
	    Salsa.Rewrite.sliceExpr e_salsa 0 (Salsa.Types.Nop(Salsa.Types.Lab 0))
302
	  with _ -> Format.eprintf "Issues rewriting express %s@.@?" (Salsa.Print.printExpression e_salsa); assert false
303
        in
304
        let def_tmps = Salsa.Utils.flatten_seq seq [] in
305
        (* Registering tmp ids in vars_env *)
306
        let vars_env', new_local_vars = List.fold_left
307
	                                  (fun (vs,vars) (id, _) ->
308
	                                    let vdecl = Corelang.mk_fresh_var
309
	                                                  nodename
310
	                                                  Location.dummy_loc
311
	                                                  e.MT.value_type
312
	                                                  (Clocks.new_var true)
313
	                                              
314
	                                    in
315
	                                    let vs' =
316
	                                      VarEnv.add
317
	                                        id
318
	                                        {
319
		                                  vdecl = vdecl ;
320
		                                  is_local = true;
321
	                                        }
322
	                                        vs
323
	                                    in
324
	                                    let vars' = Vars.add vdecl vars in
325
	                                    vs', vars'
326
	                                  )
327
	                                  (vars_env,Vars.empty)
328
	                                  def_tmps
329
        in 
330
        (* Debug *)
331
        if !debug then (
332
	  report ~level:3 (fun fmt ->
333
	      Format.fprintf  fmt "List of slices: @[<v 0>%a@]@ "
334
	        (Utils.fprintf_list
335
	           ~sep:"@ "
336
	           (fun fmt (id, e_id) ->
337
		     Format.fprintf fmt "(%s,%a) -> %a"
338
		       id
339
		       Printers.pp_var (get_var vars_env' id).vdecl
340
		       (C_backend_common.pp_c_val m "" (C_backend_common.pp_c_var_read m)) (salsa_expr2value_t vars_env' constEnv e_id)
341
	           )
342
	        )
343
	        def_tmps;
344
	      Format.fprintf fmt "Sliced expression: %a@ "
345
	        (C_backend_common.pp_c_val m "" (C_backend_common.pp_c_var_read m)) (salsa_expr2value_t vars_env' constEnv e_salsa)
346
	      ;
337 347
	));
338
      (* Debug *)
339
      
340
      (* Optimize def tmp, and build the associated instructions.  Update the
348
        (* Debug *)
349
        
350
        (* Optimize def tmp, and build the associated instructions.  Update the
341 351
	 abstract Env with computed ranges *)
342
      if !debug && List.length def_tmps >= 1 then (
343
	Log.report ~level:3 (fun fmt -> Format.fprintf fmt "@[<v 3>Optimizing sliced sub-expressions@ ")
344
      );
345
      let rev_def_tmp_instrs, ranges =
346
	List.fold_left (fun (accu_instrs, ranges) (id, e_id) ->
347
	  (* Format.eprintf "Cleaning/Optimizing %s@." id; *)
348
	  let e_id', e_range = (*Salsa.MainEPEG.transformExpression id e_id abstractEnv*)
349
	    opt_num_expr_sliced ranges e_id
350
	  in
351
	  let new_e_id' = try salsa_expr2value_t vars_env' constEnv e_id'  with Not_found -> assert false in
352

  
353
	  let vdecl = (get_var vars_env' id).vdecl in
354
	  
355
	  let new_local_assign =
356
	    (* let expr = salsa_expr2value_t vars_env' constEnv e_id' in *)
357
	    MT.MLocalAssign(vdecl, new_e_id')
358
	  in
359
	  let new_local_assign = {
360
	    MT.instr_desc = new_local_assign;
361
	    MT.lustre_eq = None (* could be Corelang.mkeq Location.dummy_loc
352
        if !debug && List.length def_tmps >= 1 then (
353
	  report ~level:3 (fun fmt -> Format.fprintf fmt "@[<v 3>Optimizing sliced sub-expressions@ ")
354
        );
355
        let rev_def_tmp_instrs, ranges =
356
	  List.fold_left (fun (accu_instrs, ranges) (id, e_id) ->
357
	      (* Format.eprintf "Cleaning/Optimizing %s@." id; *)
358
	      let e_id', e_range = (*Salsa.MainEPEG.transformExpression id e_id abstractEnv*)
359
	        opt_num_expr_sliced ranges e_id
360
	      in
361
	      let new_e_id' = try salsa_expr2value_t vars_env' constEnv e_id'  with Not_found -> assert false in
362

  
363
	      let vdecl = (get_var vars_env' id).vdecl in
364
	      
365
	      let new_local_assign =
366
	        (* let expr = salsa_expr2value_t vars_env' constEnv e_id' in *)
367
	        MT.MLocalAssign(vdecl, new_e_id')
368
	      in
369
	      let new_local_assign = {
370
	          MT.instr_desc = new_local_assign;
371
	          MT.lustre_eq = None (* could be Corelang.mkeq Location.dummy_loc
362 372
				   ([vdecl.LT.var_id], e_id) provided it is
363 373
				   converted as Lustre expression rather than
364 374
				   a Machine code value *);
365
	  }
366
	  in
367
	  let new_ranges =
368
	    match e_range with
369
	      None -> ranges
370
	    | Some e_range -> RangesInt.add_def ranges id e_range in
371
	  new_local_assign::accu_instrs, new_ranges
372
	) ([], ranges) def_tmps
373
      in
374
      if !debug && List.length def_tmps >= 1 then (
375
	Log.report ~level:3 (fun fmt -> Format.fprintf fmt "@]@ ")
376
      );
377

  
378
      (* Format.eprintf "Optimizing main expression %s@.AbstractEnv is %a" (Salsa.Print.printExpression e_salsa) RangesInt.pp ranges; *)
379
      
375
	        }
376
	      in
377
	      let new_ranges =
378
	        match e_range with
379
	          None -> ranges
380
	        | Some e_range -> RangesInt.add_def ranges id e_range in
381
	      new_local_assign::accu_instrs, new_ranges
382
	    ) ([], ranges) def_tmps
383
        in
384
        if !debug && List.length def_tmps >= 1 then (
385
	  report ~level:3 (fun fmt -> Format.fprintf fmt "@]@ ")
386
        );
387

  
388
        (* Format.eprintf "Optimizing main expression %s@.AbstractEnv is %a" (Salsa.Print.printExpression e_salsa) RangesInt.pp ranges; *)
389
        
380 390

  
381
      let expr_salsa, expr_range = opt_num_expr_sliced ranges e_salsa in
382
      let expr = try salsa_expr2value_t vars_env' constEnv expr_salsa   with Not_found -> assert false in
391
        let expr_salsa, expr_range = opt_num_expr_sliced ranges e_salsa in
392
        let expr = try salsa_expr2value_t vars_env' constEnv expr_salsa   with Not_found -> assert false in
383 393

  
384
      expr, expr_range, List.rev rev_def_tmp_instrs, new_local_vars
394
        expr, expr_range, List.rev rev_def_tmp_instrs, new_local_vars
385 395

  
386 396

  
387 397

  
388
     (* ???? Bout de code dans unstable lors du merge avec salsa ? 
398
    (* ???? Bout de code dans unstable lors du merge avec salsa ? 
389 399
      ====
390 400

  
391 401
      let new_e = try salsa_expr2value_t vars_env' constEnv new_e_salsa   with Not_found -> assert false in
......
412 422
	e, None, []
413 423
      )
414 424
>>>>>>> unstable
415
      *)
425
     *)
416 426
    )
417 427

  
418 428

  
419
      
429
    
420 430
  in
421 431
  opt_expr m vars_env ranges formalEnv e  
422 432
    
......
431 441
      (FormalEnv.get_sort_fun formalEnv) 
432 442
      (Vars.elements vars_to_print) 
433 443
  in
434
  if !debug then Log.report ~level:4 (fun fmt -> Format.fprintf fmt
444
  if !debug then report ~level:4 (fun fmt -> Format.fprintf fmt
435 445
    "Printing vars in the following order: [%a]@ "
436 446
    (Utils.fprintf_list ~sep:", " Printers.pp_var) ordered_vars);
437 447
  
438 448
  List.fold_right (
439 449
    fun v (accu_instr, accu_ranges, accu_new_locals) -> 
440
      if !debug then  Log.report ~level:4 (fun fmt -> Format.fprintf fmt "Printing assign for variable %s@ " v.LT.var_id);
450
      if !debug then report ~level:4 (fun fmt -> Format.fprintf fmt "Printing assign for variable %s@ " v.LT.var_id);
441 451
      try
442 452
	(* Obtaining unfold expression of v in formalEnv *)
443 453
	let v_def = FormalEnv.get_def formalEnv v  in
......
824 834
  let unused = (Vars.diff all_local_vars printed_vars) in
825 835
  let locals =
826 836
    if not (Vars.is_empty unused) then (
827
      if !debug then Log.report ~level:2 (fun fmt -> Format.fprintf fmt  "Unused local vars: [%a]. Removing them.@ "
837
      if !debug then report ~level:2 (fun fmt -> Format.fprintf fmt  "Unused local vars: [%a]. Removing them.@ "
828 838
	Vars.pp unused);
829 839
      List.filter (fun v -> not (Vars.mem v unused)) s.MT.step_locals
830 840
    )
......
837 847

  
838 848
let machine_t2machine_t_optimized_by_salsa constEnv  mt =
839 849
  try
840
    if !debug then Log.report ~level:2 (fun fmt -> Format.fprintf fmt "@[<v 3>[salsa] Optimizing machine %s@ " mt.MT.mname.LT.node_id);
850
    if !debug then report ~level:2 (fun fmt -> Format.fprintf fmt "@[<v 3>Optimizing machine %s@ " mt.MT.mname.LT.node_id);
841 851
    let new_step = salsaStep constEnv  mt mt.MT.mstep in
842
    if !debug then Log.report ~level:2 (fun fmt -> Format.fprintf fmt "@]@ ");
852
    if !debug then report ~level:2 (fun fmt -> Format.fprintf fmt "@]@ ");
843 853
    { mt with MT.mstep = new_step } 
844 854
    
845 855
      

Also available in: Unified diff