Project

General

Profile

Revision 27dc3869

View differences:

src/main_lustre_compiler.ml
211 211
  
212 212
  (* Normalization phase *)
213 213
  Log.report ~level:1 (fun fmt -> fprintf fmt ".. normalization@,");
214
  (* Special treatment of arrows in lustre backend. We want to keep them *)
215
  if !Options.output = "lustre" then
216
    Normalization.unfold_arrow_active := false;
217
  let prog = Normalization.normalize_prog prog in
214
  let prog = Normalization.normalize_prog ~backend:!Options.output prog in
218 215
  Log.report ~level:2 (fun fmt -> fprintf fmt "@[<v 2>@ %a@]@," Printers.pp_prog prog);
219 216

  
220 217
  let prog =
src/normalization.ml
14 14
open Corelang
15 15
open Format
16 16

  
17
(** Normalisation iters through the AST of expressions and bind fresh definition
18
    when some criteria are met. This creation of fresh definition is performed by
19
    the function mk_expr_alias_opt when the alias argument is on.
20

  
21
    Initial expressions, ie expressions attached a variable in an equation
22
    definition are not aliased. This non-alias feature is propagated in the
23
    expression AST for array access and power construct, tuple, and some special
24
    cases of arrows.
25

  
26
    Two global variables may impact the normalization process:
27
    - unfold_arrow_active
28
    - force_alias_ite: when set, bind a fresh alias for then and else
29
      definitions.
30
*)
31

  
32
(* Two global variables *)
33
let unfold_arrow_active = ref true
34
let force_alias_ite = ref false
35

  
36
  
17 37
let expr_true loc ck =
18 38
{ expr_tag = Utils.new_tag ();
19 39
  expr_desc = Expr_const (Const_tag tag_true);
......
53 73
    { expr with expr_desc = Expr_ite (expr_once loc ck, e1, e2) }
54 74
 | _                   -> assert false
55 75

  
56
let unfold_arrow_active = ref true
57 76
let cpt_fresh = ref 0
58 77

  
59 78
(* Generate a new local [node] variable *)
......
294 313
  | Expr_merge (c, hl) ->
295 314
    let defvars, norm_hl = normalize_branches node offsets defvars hl in
296 315
    defvars, mk_norm_expr offsets expr (Expr_merge (c, norm_hl))
297
  | _ -> normalize_expr ~alias:alias node offsets defvars expr
298

  
316
  | _ when !force_alias_ite ->
317
     (* Forcing alias creation for then/else expressions *)
318
     let defvars, norm_expr =
319
       normalize_expr ~alias:alias node offsets defvars expr
320
     in
321
     mk_expr_alias_opt true node defvars norm_expr
322
  | _ -> (* default case without the force_alias_ite option *)
323
     normalize_expr ~alias:alias node offsets defvars expr
324
     
299 325
and normalize_guard node defvars expr =
300 326
  let defvars, norm_expr = normalize_expr node [] defvars expr in
301 327
  mk_expr_alias_opt true node defvars norm_expr
......
434 460
    decl'
435 461
  | Open _ | ImportedNode _ | Const _ | TypeDef _ -> decl
436 462

  
437
let normalize_prog decls =
438
  List.map normalize_decl decls
463
let normalize_prog ?(backend="C") decls =
464
  let old_unfold_arrow_active = !unfold_arrow_active in
465
  let old_force_alias_ite = !force_alias_ite in
466
  
467
  (* Backend specific configurations for normalization *)
468
  let _ =
469
    match backend with
470
    | "lustre" ->
471
    (* Special treatment of arrows in lustre backend. We want to keep them *)
472
       unfold_arrow_active := false;
473
    | "emf" -> (* Forcing ite normalization *)
474
       force_alias_ite := true;
475
    | _ -> () (* No fancy options for other backends *)
476
  in
439 477

  
440
(* Local Variables: *)
478
  (* Main algorithm: iterates over nodes *)
479
  let res = List.map normalize_decl decls in
480
  
481
  (* Restoring previous settings *)
482
  unfold_arrow_active := old_unfold_arrow_active;
483
  force_alias_ite := old_force_alias_ite;
484

  
485
  res
486
  
487
  (* Local Variables: *)
441 488
(* compile-command:"make -C .." *)
442 489
(* End: *)

Also available in: Unified diff