Project

General

Profile

Revision 86ae18b7 src/main_lustre_compiler.ml

View differences:

src/main_lustre_compiler.ml
15 15
open Utils
16 16
open LustreSpec
17 17
open Compiler_common
18
 
18

  
19 19
exception StopPhase1 of program
20 20

  
21 21
let usage = "Usage: lustrec [options] \x1b[4msource file\x1b[0m"
......
88 88
  end
89 89

  
90 90

  
91
let functional_backend () = 
91
let functional_backend () =
92 92
  match !Options.output with
93 93
  | "horn" | "lustre" | "acsl" -> true
94 94
  | _ -> false
95 95

  
96 96
(* From prog to prog *)
97 97
let stage1 prog dirname basename =
98
  (* Removing automata *) 
98
  (* Removing automata *)
99 99
  let prog = expand_automata prog in
100 100

  
101 101
  Log.report ~level:4 (fun fmt -> fprintf fmt ".. after automata expansion:@.@[<v 2>@ %a@]@," Printers.pp_prog prog);
......
137 137
       exported as a lusi *)
138 138
    raise (StopPhase1 prog);
139 139

  
140
 (* Optimization of prog: 
141
     - Unfold consts 
140
 (* Optimization of prog:
141
     - Unfold consts
142 142
     - eliminate trivial expressions
143 143
 *)
144 144
  (*
145
  let prog = 
145
  let prog =
146 146
    if !Options.const_unfold || !Options.optimization >= 5 then
147 147
      begin
148 148
	Log.report ~level:1 (fun fmt -> fprintf fmt ".. eliminating constants and aliases@,");
......
193 193
	!Options.main_node
194 194
	orig prog type_env clock_env
195 195
    end;
196
  
196

  
197 197
  (* Computes and stores generic calls for each node,
198 198
     only useful for ANSI C90 compliant generic node compilation *)
199 199
  if !Options.ansi then Causality.NodeDep.compute_generic_calls prog;
......
233 233
  prog, dependencies
234 234

  
235 235
(* from source to machine code, with optimization *)
236
let stage2 prog =    
236
let stage2 prog =
237 237
  (* Computation of node equation scheduling. It also breaks dependency cycles
238 238
     and warns about unused input or memory variables *)
239 239
  Log.report ~level:1 (fun fmt -> fprintf fmt ".. scheduling@,");
......
245 245
  Log.report ~level:3 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Printers.pp_prog prog);
246 246

  
247 247

  
248
  (* TODO Salsa optimize prog: 
248
  (* TODO Salsa optimize prog:
249 249
     - emits warning for programs with pre inside expressions
250 250
     - make sure each node arguments and memory is bounded by a local annotation
251 251
     - introduce fresh local variables for each real pure subexpression
......
269 269
      machine_code
270 270
  in
271 271
  (* Optimize machine code *)
272
  let machine_code, removed_table = 
272
  let machine_code, removed_table =
273 273
    if !Options.optimization >= 2 && !Options.output <> "horn" then
274 274
      begin
275 275
	Log.report ~level:1 (fun fmt -> fprintf fmt ".. machines optimization: constants inlining@,");
......
277 277
      end
278 278
    else
279 279
      machine_code, IMap.empty
280
  in  
280
  in
281 281
  (* Optimize machine code *)
282
  let machine_code = 
282
  let machine_code =
283 283
    if !Options.optimization >= 3 && !Options.output <> "horn" then
284 284
      begin
285 285
	Log.report ~level:1 (fun fmt -> fprintf fmt ".. machines optimization: minimize stack usage by reusing variables@,");
......
290 290
    else
291 291
      machine_code
292 292
  in
293
  
294
  (* Salsa optimize machine code *)
293

  
294
 (* Salsa optimize machine code *)
295 295
  (*
296
  let machine_code = 
296
  let machine_code =
297 297
    if !Options.salsa_enabled then
298 298
      begin
299 299
	check_main ();
......
305 305
	    | Const c when Types.is_real_type c.const_type  ->
306 306
	      (c.const_id, c.const_value) :: accu
307 307
	    | _ -> accu
308
	) [] (Corelang.get_consts prog) 
308
	) [] (Corelang.get_consts prog)
309 309
	in
310
	List.map 
311
	  (Machine_salsa_opt.machine_t2machine_t_optimized_by_salsa constEnv) 
312
	  machine_code 
310
	List.map
311
	  (Machine_salsa_opt.machine_t2machine_t_optimized_by_salsa constEnv)
312
	  machine_code
313 313
      end
314 314
    else
315 315
      machine_code
......
325 325
let stage3 prog machine_code dependencies basename =
326 326
  let basename    =  Filename.basename basename in
327 327
  match !Options.output with
328
    "C" -> 
328
    "C" ->
329 329
      begin
330 330
	Log.report ~level:1 (fun fmt -> fprintf fmt ".. C code generation@,");
331 331
	C_backend.translate_to_c
......
387 387
    else
388 388
      prog
389 389
  in
390
  let prog, dependencies = 
391
    try 
390
  let prog, dependencies =
391
    try
392 392
      stage1 prog dirname basename
393 393
    with StopPhase1 prog -> (
394 394
      if !Options.lusi then
......
404 404
    )
405 405
  in
406 406

  
407
  let machine_code = 
408
    stage2 prog 
407
  let machine_code =
408
    stage2 prog
409 409
  in
410 410
  if Scopes.Plugin.show_scopes () then
411 411
    begin
......
415 415
	Format.printf "Possible scopes are:@   ";
416 416
      Format.printf "@[<v>%a@ @]@.@?" Scopes.print_scopes all_scopes;
417 417
      exit 0
418
	
418

  
419 419
    end;
420 420

  
421
  let machine_code = 
421
  let machine_code =
422 422
    if Scopes.Plugin.is_active () then
423 423
      Scopes.Plugin.process_scopes !Options.main_node prog machine_code
424 424
    else
425 425
      machine_code
426 426
  in
427
  
427

  
428 428
  stage3 prog machine_code dependencies basename;
429 429
  Log.report ~level:1 (fun fmt -> fprintf fmt ".. done @ @]@.");
430 430
    (* We stop the process here *)
......
437 437
  | _        -> assert false
438 438

  
439 439
let anonymous filename =
440
  Printf.eprintf "\n\nAnonymous called with : %s\n" filename;
440 441
  let ok_ext, ext = List.fold_left
441 442
    (fun (ok, ext) ext' ->
442 443
      if not ok && Filename.check_suffix filename ext' then
......
456 457
  Corelang.add_internal_funs ();
457 458
  try
458 459
    Printexc.record_backtrace true;
460
    (* Printf.eprintf "\nParsing\n"; *)
461
    (* Arg.parse Options.options anonymous usage; *)
462
    (* Printf.eprintf "\nDest=%s\n" !Options.dest_file; *)
459 463

  
460
    let options = Options.options @ 
464

  
465
    let options = Options.options @
461 466
      List.flatten (
462 467
	List.map Options.plugin_opt [
463 468
	  Scopes.Plugin.name, Scopes.Plugin.activate, Scopes.Plugin.options
464 469
	]
465 470
      )
466 471
    in
467
    
472

  
468 473
    Arg.parse options anonymous usage
474

  
469 475
  with
470 476
  | Parse.Error _
471 477
  | Types.Error (_,_) | Clocks.Error (_,_)

Also available in: Unified diff