Project

General

Profile

Revision c1adf235 src/corelang.ml

View differences:

src/corelang.ml
460 460
let node_eq id node =
461 461
 List.find (fun eq -> List.mem id eq.eq_lhs) node.node_eqs
462 462

  
463
(* Consts unfoooolding *)
464
let is_const i consts = 
465
  List.exists (fun c -> c.const_id = i) consts
466

  
467
let get_const i consts =
468
  let c = List.find (fun c -> c.const_id = i) consts in
469
  c.const_value
470

  
471
let rec expr_unfold_consts consts e = 
472
{ e with expr_desc = expr_desc_unfold_consts consts e.expr_desc }
473

  
474
and expr_desc_unfold_consts consts e =
475
  let unfold = expr_unfold_consts consts in
476
  match e with
477
  | Expr_const _ -> e
478
  | Expr_ident i -> if is_const i consts then Expr_const (get_const i consts) else e
479
  | Expr_array el -> Expr_array (List.map unfold el)
480
  | Expr_access (e1, d) -> Expr_access (unfold e1, d)
481
  | Expr_power (e1, d) -> Expr_power (unfold e1, d)
482
  | Expr_tuple el -> Expr_tuple (List.map unfold el)
483
  | Expr_ite (c, t, e) -> Expr_ite (unfold c, unfold t, unfold e)
484
  | Expr_arrow (e1, e2)-> Expr_arrow (unfold e1, unfold e2) 
485
  | Expr_fby (e1, e2) -> Expr_fby (unfold e1, unfold e2)
486
  (* | Expr_concat (e1, e2) -> Expr_concat (unfold e1, unfold e2) *)
487
  (* | Expr_tail e' -> Expr_tail (unfold e') *)
488
  | Expr_pre e' -> Expr_pre (unfold e')
489
  | Expr_when (e', i, l)-> Expr_when (unfold e', i, l)
490
  | Expr_merge (i, hl) -> Expr_merge (i, List.map (fun (t, h) -> (t, unfold h)) hl)
491
  | Expr_appl (i, e', i') -> Expr_appl (i, unfold e', i')
492
  | Expr_uclock (e', i) -> Expr_uclock (unfold e', i) 
493
  | Expr_dclock (e', i) -> Expr_dclock (unfold e', i)
494
  | Expr_phclock _ -> e  
495

  
496
let eq_unfold_consts consts eq =
497
  { eq with eq_rhs = expr_unfold_consts consts eq.eq_rhs }
498

  
499
let node_unfold_consts consts node = 
500
  { node with node_eqs = List.map (eq_unfold_consts consts) node.node_eqs }
501

  
502
let get_consts prog = 
503
  List.fold_left (
504
    fun consts decl ->
505
      match decl.top_decl_desc with
506
	| Consts clist -> clist@consts
507
	| Node _ | ImportedNode _ | Open _ -> consts  
508
  ) [] prog
509

  
510

  
511 463
let get_nodes prog = 
512 464
  List.fold_left (
513 465
    fun nodes decl ->
......
516 468
	| Consts _ | ImportedNode _ | Open _ -> nodes  
517 469
  ) [] prog
518 470

  
519
let prog_unfold_consts prog =
520
  let consts = get_consts prog in
521
    List.map (
522
      fun decl -> match decl.top_decl_desc with 
523
	| Node nd -> {decl with top_decl_desc = Node (node_unfold_consts consts nd)}
524
	| _       -> decl
525
    ) prog 
471
let get_consts prog = 
472
  List.fold_left (
473
    fun consts decl ->
474
      match decl.top_decl_desc with
475
	| Consts clist -> clist@consts
476
	| Node _ | ImportedNode _ | Open _ -> consts  
477
  ) [] prog
526 478

  
527 479

  
528 480

  

Also available in: Unified diff