Project

General

Profile

Revision 8e6cab20

View differences:

src/backends/C/c_backend_makefile.ml
49 49
  let compiled_dep = compiled_dependencies dep in
50 50
  (* Format.eprintf "Compiled Deps: %a@." pp_deps compiled_dep; *)
51 51
 
52
  List.iter (fun s -> Format.eprintf "Adding dependency: %s@." s;  
52
  List.iter (fun s -> Log.report ~level:1 (fun fmt -> fprintf fmt "Adding dependency: %s@." s);  
53 53
    fprintf fmt "\t${GCC} -I${INC} -c %s@." s)
54 54
    (("${INC}/io_frontend.c"):: (* IO functions when a main function is computed *)
55 55
	(List.map 
src/compiler_stages.ml
236 236
  Log.report ~level:3 (fun fmt -> fprintf fmt ".. generated machines (unoptimized):@ %a@ " Machine_code_common.pp_machines machine_code);
237 237

  
238 238
  (* Optimize machine code *)
239
  Optimize_machine.optimize prog node_schs machine_code
239
  Optimize_machine.optimize prog node_schs machine_code   
240 240

  
241 241

  
242 242
(* printing code *)
src/main_lustre_compiler.ml
88 88
        assert false
89 89
    )
90 90
  in
91
  Log.report ~level:1 (fun fmt -> fprintf fmt "@]@,");
92 91
  Log.report ~level:3 (fun fmt -> fprintf fmt ".. Normalized program:@ %a@ "Printers.pp_prog prog);
92
  Log.report ~level:1 (fun fmt -> fprintf fmt "@]@,");
93 93

  
94 94
  Log.report ~level:1 (fun fmt -> fprintf fmt "@[<v 2>.. Phase 2 : Machines generation@,");
95 95

  
......
97 97
    Compiler_stages.stage2 prog 
98 98
  in
99 99

  
100
  Log.report ~level:1 (fun fmt -> fprintf fmt "@]@ ");
101 100
  Log.report ~level:3 (fun fmt -> fprintf fmt ".. Generated machines:@ %a@ " Machine_code_common.pp_machines machine_code);
102 101

  
103 102
  if Scopes.Plugin.show_scopes () then
......
110 109
      exit 0
111 110
	
112 111
    end;
113

  
114 112
  let machine_code = Plugins.refine_machine_code prog machine_code in
113
  Log.report ~level:1 (fun fmt -> fprintf fmt "xxx@]@ yyy@ ");
115 114
  
116 115
  Compiler_stages.stage3 prog machine_code dependencies basename;
117 116
  begin
src/optimize_machine.ml
612 612
      machine_code
613 613
  in
614 614
  
615
  (* Salsa optimize machine code *)
616
  (*
617
  let machine_code = 
618
    if !Options.salsa_enabled then
619
      begin
620
	check_main ();
621
	Log.report ~level:1 (fun fmt -> fprintf fmt ".. salsa machines optimization: optimizing floating-point accuracy with Salsa@,");
622
	(* Selecting float constants for Salsa *)
623
	let constEnv = List.fold_left (
624
	  fun accu c_topdecl ->
625
	    match c_topdecl.top_decl_desc with
626
	    | Const c when Types.is_real_type c.const_type  ->
627
	      (c.const_id, c.const_value) :: accu
628
	    | _ -> accu
629
	) [] (Corelang.get_consts prog) 
630
	in
631
	List.map 
632
	  (Machine_salsa_opt.machine_t2machine_t_optimized_by_salsa constEnv) 
633
	  machine_code 
634
      end
635
    else
636
      machine_code
637
  in
638
  Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@ "
639
    (Utils.fprintf_list ~sep:"@ " Machine_code.pp_machine)
640
    machine_code);
641
  *)
642

  
643 615

  
644 616
    machine_code  
645 617
    
src/plugins/salsa/machine_salsa_opt.ml
132 132
    | Access _
133 133
    | Power _ -> assert false  
134 134
  and opt_num_expr vars_env ranges formalEnv e = 
135
    if !debug then (
136
      Log.report ~level:2 (fun fmt -> Format.fprintf fmt "Optimizing expression %a@ "
137
	MC.pp_val e);
138
    );
135 139
    (* if !debug then Format.eprintf "Optimizing expression %a with Salsa@ " MC.pp_val e;  *)
136 140
    let fresh_id = "toto"  in (* TODO more meaningful name *)
137 141
    (* Convert expression *)
......
143 147
    (* if !debug then Format.eprintf "Formal env is [%a]@ " FormalEnv.pp formalEnv; *)
144 148
    (* if !debug then Format.eprintf "Formal env converted to salsa@ "; *)
145 149

  
146
    Format.eprintf "Expression avant et apres substVars.@.Avant %a@." MC.pp_val (salsa_expr2value_t vars_env [] e_salsa) ;  
150
    (* Format.eprintf "Expression avant et apres substVars.@.Avant %a@." MC.pp_val (salsa_expr2value_t vars_env [] e_salsa) ;   *)
147 151

  
148 152
    (* Substitute all occurences of variables by their definition in env *)
149 153
    let (e_salsa: Salsa.Types.expression), _ = 
......
153 157
	0 (* TODO: Nasrine, what is this integer value for ? *)
154 158
    in
155 159

  
156
    Format.eprintf "Apres %a@." MC.pp_val (salsa_expr2value_t vars_env [] e_salsa) ;  
160
    (* Format.eprintf "Apres %a@." MC.pp_val (salsa_expr2value_t vars_env [] e_salsa) ;   *)
157 161

  
158 162
    (* if !debug then Format.eprintf "Substituted def in expr@ "; *)
159 163
    let abstractEnv = RangesInt.to_abstract_env ranges in
......
163 167
       garde evalPartExpr remplace les variables e qui sont dans env par la cst
164 168
       - on garde *)
165 169
    (* if !debug then Format.eprintf "avant avant eval part@ "; *)
166
    Format.eprintf "avant evalpart: %a@." MC.pp_val (salsa_expr2value_t vars_env constEnv e_salsa);
170
    (* Format.eprintf "avant evalpart: %a@." MC.pp_val (salsa_expr2value_t vars_env constEnv e_salsa); *)
167 171
    let e_salsa =  
168 172
      Salsa.Analyzer.evalPartExpr 
169 173
	e_salsa
......
171 175
	([] (* no blacklisted variables *))
172 176
	([] (* no arrays *))
173 177
    in
174
    Format.eprintf "apres evalpart: %a@." MC.pp_val (salsa_expr2value_t vars_env constEnv e_salsa);
178
    (* Format.eprintf "apres evalpart: %a@." MC.pp_val (salsa_expr2value_t vars_env constEnv e_salsa); *)
175 179
    (* Checking if we have all necessary information *)
176 180

  
177 181
    let free_vars = get_salsa_free_vars vars_env constEnv abstractEnv e_salsa in
......
179 183
      Log.report ~level:2 (fun fmt -> Format.fprintf fmt "Warning: unbounded free vars (%a) in expression %a. We do not optimize it.@ " 
180 184
	Vars.pp (Vars.fold (fun v accu -> let v' = {v with LT.var_id = nodename.LT.node_id ^ "." ^ v.LT.var_id } in Vars.add v' accu) free_vars Vars.empty)
181 185
	MC.pp_val (salsa_expr2value_t vars_env constEnv e_salsa));
182
      if !debug then Format.eprintf "Some free vars, not optimizing@.";
186
      if !debug then Log.report ~level:2 (fun fmt -> Format.fprintf fmt  "Some free vars, not optimizing@ ");
187
      if !debug then Log.report ~level:3 (fun fmt -> Format.fprintf fmt "  ranges: %a@ "
188
	RangesInt.pp ranges);
189

  
190
      (* if !debug then Log.report ~level:2 (fun fmt -> Format.fprintf fmt "Formal env was @[<v 0>%a@]@ " FormalEnv.pp formalEnv); *)
191
	
183 192
      
184 193
      let new_e = try salsa_expr2value_t vars_env constEnv e_salsa   with Not_found -> assert false in
185 194
      new_e, None, []
......
188 197
      
189 198
      try 
190 199
	if !debug then
191
	  Format.eprintf "Analyzing expression %a with env: @[<v>%a@ @]@ @?"
200
	  Log.report ~level:3 (fun fmt -> Format.fprintf fmt "Analyzing expression %a with ranges: @[<v>%a@ @]@ "
192 201
	    (C_backend_common.pp_c_val "" (C_backend_common.pp_c_var_read m)) (salsa_expr2value_t vars_env constEnv e_salsa)
193
	    (Utils.fprintf_list ~sep:",@ "(fun fmt (l,r) -> Format.fprintf fmt "%s -> %a" l FloatIntSalsa.pp r)) abstractEnv
202
	    (Utils.fprintf_list ~sep:",@ "(fun fmt (l,r) -> Format.fprintf fmt "%s -> %a" l FloatIntSalsa.pp r)) abstractEnv)
194 203
	;
195 204

  
196
	Format.eprintf "going to slice@.";
205
	(* Format.eprintf "going to slice@."; *)
197 206
	(* Slicing it XXX C'est là !!! ploc *)
198 207
	let e_salsa, seq = Salsa.Rewrite.sliceExpr e_salsa 0 (Salsa.Types.Nop(Salsa.Types.Lab 0)) in
199
	Format.eprintf "sliced@.";
208
	(* Format.eprintf "sliced@."; *)
200 209
	let def_tmps = Salsa.Utils.flatten_seq seq [] in
201 210
	(* Registering tmp ids in vars_env *)
202 211
	let vars_env' = List.fold_left
......
216 225
	  vars_env
217 226
	  def_tmps
218 227
	in 
219
	Format.eprintf "List of tmp: @[<v 0>%a@]"
220
	  (
221
	    Utils.fprintf_list
222
	      ~sep:"@ "
223
	      (fun fmt (id, e_id) ->
224
		Format.fprintf fmt "(%s,%a) -> %a"
225
		  id
226
		  Printers.pp_var (get_var vars_env' id).vdecl
227
		  (C_backend_common.pp_c_val "" (C_backend_common.pp_c_var_read m)) (salsa_expr2value_t vars_env' constEnv e_id)
228
	      )
229
	  )
230
	  def_tmps;
231
	Format.eprintf "Sliced expression %a@.@?"
232
	  (C_backend_common.pp_c_val "" (C_backend_common.pp_c_var_read m)) (salsa_expr2value_t vars_env' constEnv e_salsa)
233
	;
228
	(* Format.eprintf "List of tmp: @[<v 0>%a@]" *)
229
	(*   ( *)
230
	(*     Utils.fprintf_list *)
231
	(*       ~sep:"@ " *)
232
	(*       (fun fmt (id, e_id) -> *)
233
	(* 	Format.fprintf fmt "(%s,%a) -> %a" *)
234
	(* 	  id *)
235
	(* 	  Printers.pp_var (get_var vars_env' id).vdecl *)
236
	(* 	  (C_backend_common.pp_c_val "" (C_backend_common.pp_c_var_read m)) (salsa_expr2value_t vars_env' constEnv e_id) *)
237
	(*       ) *)
238
	(*   ) *)
239
	(*   def_tmps; *)
240
	(* Format.eprintf "Sliced expression %a@.@?" *)
241
	(*   (C_backend_common.pp_c_val "" (C_backend_common.pp_c_var_read m)) (salsa_expr2value_t vars_env' constEnv e_salsa) *)
242
	(* ; *)
234 243

  
235 244
	(* Optimize def tmp, and build the associated instructions. Update the abstract Env with computed ranges *)
236 245
	let rev_def_tmp_instrs, ranges =
237 246
	  List.fold_left (fun (accu_instrs, ranges) (id, e_id) ->
238
	    Format.eprintf "Cleaning/Optimizing %s@." id;
247
	    (* Format.eprintf "Cleaning/Optimizing %s@." id; *)
239 248
	    let abstractEnv = RangesInt.to_abstract_env ranges in
240 249
	    let e_id', e_range = Salsa.MainEPEG.transformExpression id e_id abstractEnv in
241 250

  
......
259 268
	  ) ([], ranges) def_tmps
260 269
	in
261 270

  
262
	Format.eprintf "Optimizing main expression %s@.AbstractEnv is %a" (Salsa.Print.printExpression e_salsa) RangesInt.pp ranges;
271
	(* Format.eprintf "Optimizing main expression %s@.AbstractEnv is %a" (Salsa.Print.printExpression e_salsa) RangesInt.pp ranges; *)
263 272
	
264 273
	let abstractEnv = RangesInt.to_abstract_env ranges in
265 274
	let new_e_salsa, e_val = 
......
269 278
	(* let range_after = Float.evalExpr new_e_salsa abstractEnv in *)
270 279

  
271 280
    	let new_e = try salsa_expr2value_t vars_env' constEnv new_e_salsa   with Not_found -> assert false in
272
	if !debug then Format.eprintf "@  @[<v>old_expr: @[<v 0>%a@ range: %a@]@ new_expr: @[<v 0>%a@ range: %a@]@ @]"
273
	  MC.pp_val e
274
	  RangesInt.pp_val (Salsa.Analyzer.evalExpr e_salsa abstractEnv [])
275
	  MC.pp_val new_e
276
	  RangesInt.pp_val e_val;
281
	if !debug then Log.report ~level:2 (fun fmt ->
282
	  let old_range = Salsa.Analyzer.evalExpr e_salsa abstractEnv [] in
283
	  match RangesInt.Value.leq old_range e_val, RangesInt.Value.leq e_val old_range with
284
	  | true, true -> Format.fprintf fmt "No improvement on abstract value %a@ " RangesInt.pp_val e_val
285
	  | true, false -> (
286
	    Format.fprintf fmt "Improved!";
287
	    Format.fprintf fmt
288
	      "  @[<v>old_expr: @[<v 0>%a@ range: %a@]@ new_expr: @[<v 0>%a@ range: %a@]@ @]@ "
289
	      MC.pp_val e
290
	      RangesInt.pp_val (Salsa.Analyzer.evalExpr e_salsa abstractEnv [])
291
	      MC.pp_val new_e
292
	      RangesInt.pp_val e_val
293
	  )
294
	  | false, true -> Format.eprintf "Error; new range is worse!@.@?"; assert false
295
	  | false, false -> Format.eprintf "Error; new range is not comparabe with old end. This should not happen!@.@?"; assert false
296
	);
277 297
	new_e, Some e_val, List.rev rev_def_tmp_instrs
278 298
      with (* Not_found ->  *)
279 299
      | Salsa.Epeg_types.EPEGError _ -> (
280
	Format.eprintf "BECAUSE OF AN ERROR, Expression %a was not optimized@ " MC.pp_val e;
300
	Log.report ~level:2 (fun fmt -> Format.fprintf fmt "BECAUSE OF AN ERROR, Expression %a was not optimized@ " MC.pp_val e);
281 301
	e, None, []
282 302
      )
283 303
    )
284 304

  
285 305

  
286

  
306
    
287 307
  in
288
  if !debug then 
289
    Format.eprintf "@[<v 2>Optimizing expression %a in environment %a and ranges %a@ "
290
      MC.pp_val e
291
      FormalEnv.pp formalEnv
292
      RangesInt.pp ranges;
293
  let res = opt_expr vars_env ranges formalEnv e in
294
  Format.eprintf "@]@ ";
295
  res
296

  
308
  opt_expr vars_env ranges formalEnv e  
297 309
    
298 310
    
299 311
(* Returns a list of assign, for each var in vars_to_print, that produce the
......
306 318
      (FormalEnv.get_sort_fun formalEnv) 
307 319
      (Vars.elements vars_to_print) 
308 320
  in
309
  if !debug then Format.eprintf "Printing vars in the following order: [%a]@ " (Utils.fprintf_list ~sep:", " Printers.pp_var) ordered_vars ;
321
  if !debug then Log.report ~level:4 (fun fmt -> Format.fprintf fmt
322
    "Printing vars in the following order: [%a]@ "
323
    (Utils.fprintf_list ~sep:", " Printers.pp_var) ordered_vars);
324
  
310 325
  List.fold_right (
311 326
    fun v (accu_instr, accu_ranges) -> 
312
      if !debug then Format.eprintf "Printing assign for variable %s@ " v.LT.var_id;
327
      if !debug then  Log.report ~level:4 (fun fmt -> Format.fprintf fmt "Printing assign for variable %s@ " v.LT.var_id);
313 328
      try
314 329
	(* Obtaining unfold expression of v in formalEnv *)
315 330
	let v_def = FormalEnv.get_def formalEnv v  in
......
335 350
   ranges, formalEnv, printed_vars, and remaining vars to be printed) *)
336 351
let rec rewrite_instrs nodename m constEnv  vars_env m instrs ranges formalEnv printed_vars vars_to_print =
337 352
  let formal_env_def = FormalEnv.def constEnv vars_env in
338
  Format.eprintf "Rewrite intrs : [%a]@." MC.pp_instrs instrs;
353
  (* Format.eprintf "Rewrite intrs : [%a]@." MC.pp_instrs instrs; *)
339 354
  let assign_vars = assign_vars nodename m constEnv vars_env in
340
  if !debug then (
341
    Format.eprintf "@.------------@ ";
342
    Format.eprintf "Current printed_vars: [%a]@ " Vars.pp printed_vars;
343
    Format.eprintf "Vars to print: [%a]@ " Vars.pp vars_to_print;
344
    Format.eprintf "Formal env is [%a]@ " FormalEnv.pp formalEnv;
345
  );
355
  (* if !debug then ( *)
356
  (*   Log.report ~level:3 (fun fmt -> Format.fprintf fmt    *)
357
  (*     "Current printed_vars: [%a]@ Vars to print: [%a]@ Formal env is [%a]@ " *)
358
  (*     Vars.pp printed_vars *)
359
  (*     Vars.pp vars_to_print *)
360
  (*     FormalEnv.pp formalEnv) *)
361
  (* ); *)
346 362
  match instrs with
347 363
  | [] -> 
348 364
     (* End of instruction list: we produce the definition of each variable that
349 365
	appears in vars_to_print. Each of them should be defined in formalEnv *)
350
     if !debug then Format.eprintf "Producing definitions %a@ " Vars.pp vars_to_print;
366
     (* if !debug then Format.eprintf "Producing definitions %a@ " Vars.pp vars_to_print; *)
351 367
    let instrs, ranges' = assign_vars printed_vars ranges formalEnv vars_to_print in
352 368
    instrs,
353 369
    ranges',     
......
359 375
     (* We reformulate hd_instr, producing or not a fresh instruction, updating
360 376
	formalEnv, possibly ranges and vars_to_print *)
361 377
     begin
362
       Format.eprintf "Hdlist@.";
363 378
       let hd_instrs, ranges, formalEnv, printed_vars, vars_to_print =
364 379
	 match Corelang.get_instr_desc hd_instr with 
365 380
	 | MT.MLocalAssign(vd,vt) when Types.is_real_type vd.LT.var_type  && not (Vars.mem vd vars_to_print) -> 
366
	    Format.eprintf "local assign@.";
367 381
	   (* LocalAssign are injected into formalEnv *)
368 382
	   (* if !debug then Format.eprintf "Registering local assign %a@ " MC.pp_instr hd_instr; *)
369
	   if !debug then Format.eprintf "%a@ " MC.pp_instr hd_instr;
383
	   (* if !debug then Format.eprintf "%a@ " MC.pp_instr hd_instr; *)
370 384
	   let formalEnv' = formal_env_def formalEnv vd vt in (* formelEnv updated with vd = vt *)
371 385
	   [],                        (* no instr generated *)
372 386
	   ranges,                    (* no new range computed *)
......
375 389
	   vars_to_print              (* no more or less variables to print *)
376 390
	     
377 391
	 | MT.MLocalAssign(vd,vt) when Types.is_real_type vd.LT.var_type && Vars.mem vd vars_to_print ->
378
	    Format.eprintf "local assign 2@.";
379 392

  
380 393
           (* if !debug then Format.eprintf "Registering and producing state assign %a@ " MC.pp_instr hd_instr; *)
381 394
           (* if !debug then Format.eprintf "Registering and producing state assign %a@ " MC.pp_instr hd_instr; *)
382
           if !debug then (
383
	     Format.eprintf "%a@]@ " MC.pp_instr hd_instr;
384
	     Format.eprintf "Selected var %a: producing expression@ " Printers.pp_var vd;
385
	   );
395
           (* if !debug then ( *)
396
	   (*   Format.eprintf "%a@ " MC.pp_instr hd_instr; *)
397
	   (*   Format.eprintf "Selected var %a: producing expression@ " Printers.pp_var vd; *)
398
	   (* ); *)
386 399
	   let formalEnv' = formal_env_def formalEnv vd vt in (* formelEnv updated with vd = vt *)
387 400
	   let instrs', ranges' = (* printing vd = optimized vt *)
388 401
	     assign_vars printed_vars ranges formalEnv' (Vars.singleton vd)  
......
394 407
	   Vars.remove vd vars_to_print     (* removed vd from variables to print *)
395 408

  
396 409
	 | MT.MStateAssign(vd,vt) when Types.is_real_type vd.LT.var_type (* && Vars.mem vd vars_to_print  *)-> 
397
	    Format.eprintf "state assign of real type@.";
398 410

  
399 411
	   (* StateAssign are produced since they are required by the function. We still
400 412
	      keep their definition in the formalEnv in case it can optimize later
401 413
	      outputs. vd is removed from remaining vars_to_print *)
402 414
	   (* if !debug then Format.eprintf "Registering and producing state assign %a@ " MC.pp_instr hd_instr; *)
403
           if !debug then (
404
	     Format.eprintf "%a@]@ " MC.pp_instr hd_instr;
405
	     Format.eprintf "State assign %a: producing expression@ " Printers.pp_var vd;
406
	   );
415
           (* if !debug then ( *)
416
	   (*   Format.eprintf "%a@ " MC.pp_instr hd_instr; *)
417
	   (*   Format.eprintf "State assign %a: producing expression@ " Printers.pp_var vd; *)
418
	   (* ); *)
407 419
	   let formalEnv' = formal_env_def formalEnv vd vt in (* formelEnv updated with vd = vt *) 
408 420
	   let instrs', ranges' = (* printing vd = optimized vt *)
409 421
	     assign_vars printed_vars ranges formalEnv' (Vars.singleton vd)  
......
415 427
	   Vars.remove vd vars_to_print     (* removed vd from variables to print *)
416 428

  
417 429
	 | (MT.MLocalAssign(vd,vt) | MT.MStateAssign(vd,vt))  ->
418
	    Format.eprintf "other assign %a@." MC.pp_instr hd_instr;
430
	    (* Format.eprintf "other assign %a@." MC.pp_instr hd_instr; *)
419 431

  
420 432
	   (* We have to produce the instruction. But we may have to produce as
421 433
	      well its dependencies *)
......
424 436
									  already
425 437
									  produced
426 438
									  variables *)
427
	   Format.eprintf "Required vars: %a@." Vars.pp required_vars;
439
	   (* Format.eprintf "Required vars: %a@." Vars.pp required_vars; *)
428 440
	   let required_vars = Vars.diff required_vars (Vars.of_list m.MT.mmemory) in
429 441
	   let prefix_instr, ranges = 
430 442
	     assign_vars printed_vars ranges formalEnv required_vars in
......
445 457
						   variables to print *)
446 458

  
447 459
	 | MT.MStep(vdl,id,vtl) ->
448
	    Format.eprintf "step@.";
460
	    (* Format.eprintf "step@."; *)
449 461

  
450
	   if !debug then Format.eprintf "Call to a node %a@ " MC.pp_instr hd_instr;
462
	   (* if !debug then Format.eprintf "Call to a node %a@ " MC.pp_instr hd_instr; *)
451 463
	   (* Call of an external function. Input expressions have to be
452 464
	      optimized, their free variables produced. A fresh range has to be
453 465
	      computed for each output variable in vdl. Output of the function
......
463 475
	     else
464 476
	       fun_types node
465 477
	   in
466
	   if !debug then Format.eprintf "@[<v 2>... optimizing arguments@ ";
478
	   (* if !debug then Format.eprintf "@[<v 2>... optimizing arguments@ "; *)
467 479
	   let vtl', vtl_ranges, il = List.fold_right2 (
468 480
	     fun e typ_e (exprl, range_l, il_l)-> 
469 481
	       if Types.is_real_type typ_e then
......
473 485
		 e::exprl, None::range_l, il_l
474 486
	   ) vtl tin ([], [], []) 
475 487
	   in 
476
	   if !debug then Format.eprintf "... done@ @]@ ";
488
	   (* if !debug then Format.eprintf "... done@ @]@ "; *)
477 489

  
478 490

  
479 491

  
......
517 529
	    (* Required variables to compute vt are introduced. 
518 530
	       Then each branch is refactored specifically 
519 531
	    *)
520
	    if !debug then Format.eprintf "Branching %a@ " MC.pp_instr hd_instr;
532
	    (* if !debug then Format.eprintf "Branching %a@ " MC.pp_instr hd_instr; *)
521 533
	   let required_vars = get_expr_real_vars vt in
522 534
	   let required_vars = Vars.diff required_vars printed_vars in (* remove
523 535
									  already
......
532 544

  
533 545

  
534 546
	   let read_vars_tl = get_read_vars tl_instrs in
535
	   if !debug then Format.eprintf "@[<v 2>Dealing with branches@ ";
547
	   (* if !debug then Format.eprintf "@[<v 2>Dealing with branches@ "; *)
536 548
	   let branches', written_vars, merged_ranges = List.fold_right (
537 549
	     fun (b_l, b_instrs) (new_branches, written_vars, merged_ranges) -> 
538 550
	       let b_write_vars = get_written_vars b_instrs in
......
555 567
	       RangesInt.merge merged_ranges b_ranges      
556 568
		 
557 569
	   ) branches ([], required_vars, ranges) in
558
	   if !debug then Format.eprintf "dealing with branches done@ @]@ ";	  
570
	   (* if !debug then Format.eprintf "dealing with branches done@ @]@ ";	   *)
559 571
	   prefix_instr@[Corelang.update_instr_desc hd_instr (MT.MBranch(vt', branches'))],
560 572
	     merged_ranges, (* Only step functions call within branches
561 573
			       may have produced new ranges. We merge this data by
......
569 581

  
570 582

  
571 583
	 | MT.MReset(_) | MT.MNoReset _ | MT.MComment _ ->
572
	    if !debug then Format.eprintf "Untouched %a (non real)@ " MC.pp_instr hd_instr;
584
	    (* if !debug then Format.eprintf "Untouched %a (non real)@ " MC.pp_instr hd_instr; *)
573 585

  
574 586
	   (* Untouched instruction *)
575 587
	   [ hd_instr ],                    (* unmodified instr *)
......
579 591
	      vars_to_print                    (* no more or less variables to print *)
580 592
		
581 593
       in
582
       Format.eprintf "cic@.";
583 594
       let tl_instrs, ranges, formalEnv, printed_vars, vars_to_print = 
584 595
	 rewrite_instrs 
585 596
	   nodename
......
593 604
	   printed_vars
594 605
	   vars_to_print
595 606
       in
596
       Format.eprintf "la@.";
597 607
       hd_instrs @ tl_instrs,
598 608
       ranges,
599 609
       formalEnv, 
......
630 640
	    Num.div_num c (Num.power_num (Num.num_of_int 10) (Num.num_of_int e))
631 641
	  | _ -> 
632 642
	    Format.eprintf 
633
	      "Invalid scala range: %a. It should be a pair of constant floats.@." 
634
	      Printers.pp_expr value.LT.eexpr_qfexpr; 
643
	      "Invalid salsa range: %a. It should be a pair of constant floats and %a is not a float.@." 
644
	      Printers.pp_expr value.LT.eexpr_qfexpr
645
	      Printers.pp_expr e
646
	    ; 
635 647
	    assert false 
636 648
	in
637 649
	(* let minv = Salsa.Float.Domain.of_num (get_cst minv) and *)
......
641 653
      )
642 654
      | _ -> 
643 655
	Format.eprintf 
644
	  "Invalid scala range: %a. It should be a pair of floats.@." 
656
	  "Invalid salsa range: %a. It should be a pair of floats.@." 
645 657
	  Printers.pp_expr value.LT.eexpr_qfexpr; 
646 658
	assert false
647 659
    ) ranges annots
......
658 670
  (* TODO: should be at least step output + may be memories *)
659 671
  
660 672
  let vars_env = compute_vars_env m in  
661
  if !debug then Format.eprintf "@[<v 2>Registering node equations@ "; 
673
  (* if !debug then Format.eprintf "@[<v 2>Registering node equations@ ";  *)
662 674
  let new_instrs, _, _, printed_vars, _ = 
663 675
    rewrite_instrs
664 676
      m.MT.mname
......
678 690
  let unused = (Vars.diff all_local_vars printed_vars) in
679 691
  let locals =
680 692
    if not (Vars.is_empty unused) then (
681
      Format.eprintf "Unused local vars: [%a]. Removing them.@.@?"
682
	Vars.pp unused;
693
      if !debug then Log.report ~level:2 (fun fmt -> Format.fprintf fmt  "Unused local vars: [%a]. Removing them.@ "
694
	Vars.pp unused);
683 695
      List.filter (fun v -> not (Vars.mem v unused)) s.MT.step_locals
684 696
    )
685 697
    else
......
690 702

  
691 703
let machine_t2machine_t_optimized_by_salsa constEnv  mt =
692 704
  try
693
    if !debug then Format.eprintf "@[<v 8>[salsa] Optimizing machine %s@ " mt.MT.mname.LT.node_id;
705
    if !debug then Log.report ~level:2 (fun fmt -> Format.fprintf fmt "@[<v 3>[salsa] Optimizing machine %s@ " mt.MT.mname.LT.node_id);
694 706
    let new_step = salsaStep constEnv  mt mt.MT.mstep in
695
    if !debug then Format.eprintf "@]@ ";
707
    if !debug then Log.report ~level:2 (fun fmt -> Format.fprintf fmt "@]@ ");
696 708
    { mt with MT.mstep = new_step } 
697 709
    
698 710
      
src/plugins/salsa/salsaDatatypes.ml
13 13
  Format.fprintf fmt "]@]";
14 14

  
15 15

  
16
module type VALUE =
17
sig
18
  type t
19
  val union: t -> t -> t
20
  val pp: Format.formatter -> t -> unit
21
    val leq: t -> t -> bool
22
end
23
  
16 24
module Ranges = 
17
  functor (Value: sig type t val union: t -> t -> t val pp: Format.formatter -> t -> unit end)  ->
25
  functor (Value: VALUE)  ->
18 26
struct
27
  module Value = Value
19 28
  type t = Value.t
20 29
  type r_t = (LT.ident, Value.t) Hashtbl.t
21 30

  
......
30 39
  						    pour chaque noeud *)
31 40

  
32 41

  
33
  let pp = pp_hash ~sep:";" (fun k v fmt -> Format.fprintf fmt "%s -> %a" k Value.pp v) 
42
  let pp fmt r =
43
    if Hashtbl.length r = 0 then
44
      Format.fprintf fmt "empty"
45
    else
46
      pp_hash ~sep:";" (fun k v fmt -> Format.fprintf fmt "%s -> %a" k Value.pp v) fmt r
34 47
  let pp_val = Value.pp
35 48

  
36 49
  let add_def ranges name r = 
......
114 127
      (* else *)
115 128
      (* 	Salsa.Builder.mk_cst (ST.I(r*.(1.-.epsilon_float),r*.(1.+.epsilon_float)),Float.ulp (ST.I(r,r))) *)
116 129
    | _ -> assert false
130

  
131
  let leq = Salsa.Float.feSseq
117 132
end
118 133

  
119 134
module RangesInt = Ranges (FloatIntSalsa)
......
212 227
let get_var vars_env v =
213 228
try
214 229
  VarEnv.find v vars_env
215
with Not_found -> Format.eprintf "Impossible to find var %s in var env %a@.@?" v
230
with Not_found -> Format.eprintf "Impossible to find var %s in var env %a@ " v
216 231
  (Utils.fprintf_list ~sep:", " (fun fmt (id, _) -> Format.pp_print_string fmt id)) (VarEnv.bindings vars_env) 
217 232
  ; assert false
218 233

  
......
353 368

  
354 369
  let empty (): fe_t = Hashtbl.create 13
355 370

  
356
  let pp fmt env = pp_hash ~sep:";" (fun k (_,v) fmt -> Format.fprintf fmt "%s -> %a" k MC.pp_val v) fmt env
371
  let pp fmt env = pp_hash ~sep:";@ " (fun k (_,v) fmt -> Format.fprintf fmt "%s -> %a" k MC.pp_val v) fmt env
357 372

  
358 373

  
359 374
  let get_sort_fun env =
src/plugins/salsa/salsa_plugin.ml
22 22
    if !salsa_enabled then
23 23
      begin
24 24
	Compiler_common.check_main ();
25
	Log.report ~level:1 (fun fmt -> fprintf fmt ".. salsa machines optimization (phase 3)@ ");
25
	Log.report ~level:1 (fun fmt -> fprintf fmt ".. @[<v 0>salsa machines optimization@ ");
26 26
	(* Selecting float constants for Salsa *)
27 27
	let constEnv = List.fold_left (
28 28
	  fun accu c_topdecl ->
......
32 32
	    | _ -> accu
33 33
	) [] (Corelang.get_consts prog) 
34 34
	in
35
	List.map 
36
	  (Machine_salsa_opt.machine_t2machine_t_optimized_by_salsa constEnv) 
37
	  machine_code 
35
	let res =
36
	  List.map 
37
	    (Machine_salsa_opt.machine_t2machine_t_optimized_by_salsa constEnv) 
38
	    machine_code
39
	in
40
	Log.report ~level:1 (fun fmt -> fprintf fmt "@]@ ");
41
	res
38 42
      end
39 43
    else
40 44
      machine_code

Also available in: Unified diff