Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / optimize_prog.ml @ cf78a589

History | View | Annotate | Download (1.88 KB)

1
open Corelang
2

    
3
(* Consts unfoooolding *)
4
let is_const i consts = 
5
  List.exists (fun c -> c.const_id = i) consts
6

    
7
let get_const i consts =
8
  let c = List.find (fun c -> c.const_id = i) consts in
9
  c.const_value
10

    
11
let rec expr_unfold_consts consts e = 
12
{ e with expr_desc = expr_desc_unfold_consts consts e.expr_desc }
13

    
14
and expr_desc_unfold_consts consts e =
15
  let unfold = expr_unfold_consts consts in
16
  match e with
17
  | Expr_const _ -> e
18
  | Expr_ident i -> if is_const i consts then Expr_const (get_const i consts) else e
19
  | Expr_array el -> Expr_array (List.map unfold el)
20
  | Expr_access (e1, d) -> Expr_access (unfold e1, d)
21
  | Expr_power (e1, d) -> Expr_power (unfold e1, d)
22
  | Expr_tuple el -> Expr_tuple (List.map unfold el)
23
  | Expr_ite (c, t, e) -> Expr_ite (unfold c, unfold t, unfold e)
24
  | Expr_arrow (e1, e2)-> Expr_arrow (unfold e1, unfold e2) 
25
  | Expr_fby (e1, e2) -> Expr_fby (unfold e1, unfold e2)
26
  (* | Expr_concat (e1, e2) -> Expr_concat (unfold e1, unfold e2) *)
27
  (* | Expr_tail e' -> Expr_tail (unfold e') *)
28
  | Expr_pre e' -> Expr_pre (unfold e')
29
  | Expr_when (e', i, l)-> Expr_when (unfold e', i, l)
30
  | Expr_merge (i, hl) -> Expr_merge (i, List.map (fun (t, h) -> (t, unfold h)) hl)
31
  | Expr_appl (i, e', i') -> Expr_appl (i, unfold e', i')
32
  | Expr_uclock (e', i) -> Expr_uclock (unfold e', i) 
33
  | Expr_dclock (e', i) -> Expr_dclock (unfold e', i)
34
  | Expr_phclock _ -> e  
35

    
36
let eq_unfold_consts consts eq =
37
  { eq with eq_rhs = expr_unfold_consts consts eq.eq_rhs }
38

    
39
let node_unfold_consts consts node = 
40
  { node with node_eqs = List.map (eq_unfold_consts consts) node.node_eqs }
41

    
42

    
43

    
44
let prog_unfold_consts prog =
45
  let consts = get_consts prog in
46
    List.map (
47
      fun decl -> match decl.top_decl_desc with 
48
	| Node nd -> {decl with top_decl_desc = Node (node_unfold_consts consts nd)}
49
	| _       -> decl
50
    ) prog 
51

    
52
(* Local Variables: *)
53
(* compile-command:"make -C .." *)
54
(* End: *)