Project

General

Profile

Revision ad4774b0 src/normalization.ml

View differences:

src/normalization.ml
29 29
      definitions.
30 30
*)
31 31

  
32
(* Two global variables *)
33
let unfold_arrow_active = ref true
34
let force_alias_ite = ref false
35
let force_alias_internal_fun = ref false
32
type param_t =
33
  {
34
    unfold_arrow_active: bool;
35
    force_alias_ite: bool;
36
    force_alias_internal_fun: bool;
37
  }
38

  
39
let params = ref
40
               {
41
                 unfold_arrow_active = false;
42
                 force_alias_ite = false;
43
                 force_alias_internal_fun =false;
44
               }
36 45

  
37 46
  
38 47
let expr_true loc ck =
......
230 239
     in
231 240
     defvars, mk_norm_expr offsets expr (Expr_appl (id, expr_of_expr_list args.expr_loc norm_args, None))
232 241
  | Expr_appl (id, args, None) when Basic_library.is_expr_internal_fun expr
233
      && not (!force_alias_internal_fun || alias_basic) ->
242
      && not (!params.force_alias_internal_fun || alias_basic) ->
234 243
     let defvars, norm_args = normalize_expr ~alias:true node offsets defvars args in
235 244
     defvars, mk_norm_expr offsets expr (Expr_appl (id, norm_args, None))
236 245
  | Expr_appl (id, args, r) ->
......
248 257
       let defvars, norm_expr = normalize_expr node [] defvars norm_expr in
249 258
       normalize_expr ~alias:alias node offsets defvars norm_expr
250 259
     else
251
       mk_expr_alias_opt (alias && (!force_alias_internal_fun || alias_basic
260
       mk_expr_alias_opt (alias && (!params.force_alias_internal_fun || alias_basic
252 261
				    || not (Basic_library.is_expr_internal_fun expr)))
253 262
	 node defvars norm_expr
254
  | Expr_arrow (e1,e2) when !unfold_arrow_active && not (is_expr_once expr) ->
263
  | Expr_arrow (e1,e2) when !params.unfold_arrow_active && not (is_expr_once expr) ->
255 264
     (* Here we differ from Colaco paper: arrows are pushed to the top *)
256 265
     normalize_expr ~alias:alias node offsets defvars (unfold_arrow expr)
257 266
  | Expr_arrow (e1,e2) ->
......
328 337
  | Expr_merge (c, hl) ->
329 338
     let defvars, norm_hl = normalize_branches node offsets defvars hl in
330 339
     defvars, mk_norm_expr offsets expr (Expr_merge (c, norm_hl))
331
  | _ when !force_alias_ite ->
340
  | _ when !params.force_alias_ite ->
332 341
     (* Forcing alias creation for then/else expressions *)
333 342
     let defvars, norm_expr =
334 343
       normalize_expr ~alias:alias node offsets defvars expr
......
506 515
    decl'
507 516
  | Open _ | ImportedNode _ | Const _ | TypeDef _ -> decl
508 517

  
509
let normalize_prog ?(backend="C") decls =
510
  let old_unfold_arrow_active = !unfold_arrow_active in
511
  let old_force_alias_ite = !force_alias_ite in
512
  let old_force_alias_internal_fun = !force_alias_internal_fun in
513
  
518
let normalize_prog p decls =
514 519
  (* Backend specific configurations for normalization *)
515
  let _ =
516
    match backend with
517
    | "lustre" ->
518
    (* Special treatment of arrows in lustre backend. We want to keep them *)
519
       unfold_arrow_active := false;
520
    | "emf" -> (
521
       (* Forcing ite normalization *)
522
      force_alias_ite := true;
523
      force_alias_internal_fun := true;
524
    )
525
    | _ -> () (* No fancy options for other backends *)
526
  in
520
  params := p;
527 521

  
528 522
  (* Main algorithm: iterates over nodes *)
529
  let res = List.map normalize_decl decls in
530
  
531
  (* Restoring previous settings *)
532
  unfold_arrow_active := old_unfold_arrow_active;
533
  force_alias_ite := old_force_alias_ite;
534
  force_alias_internal_fun := old_force_alias_internal_fun;
535
  res
536
  
537
  (* Local Variables: *)
538
(* compile-command:"make -C .." *)
539
(* End: *)
523
  List.map normalize_decl decls
524

  
525
    
526
           (* Local Variables: *)
527
           (* compile-command:"make -C .." *)
528
           (* End: *)
529
    

Also available in: Unified diff