Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / optimize_prog.ml @ 1837ce98

History | View | Annotate | Download (3.49 KB)

1
open Corelang
2
open LustreSpec
3

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

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

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

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

    
34
let eq_unfold_consts consts eq =
35
  { eq with eq_rhs = expr_unfold_consts consts eq.eq_rhs }
36

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

    
40
let prog_unfold_consts prog =
41
  let consts = get_consts prog in
42
    List.map (
43
      fun decl -> match decl.top_decl_desc with 
44
	| Node nd -> {decl with top_decl_desc = Node (node_unfold_consts consts nd)}
45
	| _       -> decl
46
    ) prog 
47

    
48
let apply_stack expr stack =
49
 List.fold_left (fun expr (v, t) -> mkexpr expr.expr_loc (Expr_when (expr, v, t))) expr stack
50

    
51
let expr_distribute_when expr =
52
  let rec distrib stack expr =
53
    match expr.expr_desc with
54
    | Expr_const _
55
    | Expr_ident _
56
    | Expr_arrow _
57
    | Expr_fby _
58
    | Expr_pre _
59
	-> apply_stack expr stack
60
    | Expr_appl (id, _, _) when not (Stateless.check_node (node_from_name id))
61
	-> apply_stack expr stack
62
    | Expr_ite (c, t, e)
63
        -> let cid = ident_of_expr c in
64
           mkexpr expr.expr_loc
65
	     (Expr_merge (cid,
66
			  [(tag_true , distrib ((cid,tag_true )::stack) t);
67
			   (tag_false, distrib ((cid,tag_false)::stack) e)]))
68
    | Expr_array el -> { expr with expr_desc = (Expr_array (List.map (distrib stack) el)) }
69
    | Expr_access (e1, d) -> { expr with expr_desc = Expr_access (distrib stack e1, d) }
70
    | Expr_power (e1, d) -> { expr with expr_desc = Expr_power (distrib stack e1, d) }
71
    | Expr_tuple el -> { expr with expr_desc = Expr_tuple (List.map (distrib stack) el) }
72
    | Expr_when (e', i, l)-> distrib ((i, l)::stack) e'
73
    | Expr_merge (i, hl) -> { expr with expr_desc = Expr_merge (i, List.map (fun (t, h) -> (t, distrib stack h)) hl) }
74
    | Expr_appl (id, e', i') -> { expr with expr_desc = Expr_appl (id, distrib stack e', i')}
75
  in distrib [] expr
76

    
77
let eq_distribute_when eq =
78
  { eq with eq_rhs = expr_distribute_when eq.eq_rhs }
79

    
80
let node_distribute_when node =
81
  { node with node_eqs = List.map eq_distribute_when node.node_eqs }
82

    
83
let prog_distribute_when prog =
84
    List.map (
85
      fun decl -> match decl.top_decl_desc with 
86
	| Node nd -> {decl with top_decl_desc = Node (node_distribute_when nd)}
87
	| _       -> decl
88
    ) prog 
89
(* Local Variables: *)
90
(* compile-command:"make -C .." *)
91
(* End: *)