lustrec / src / optimize_prog.ml @ ef34b4ae
History | View | Annotate | Download (4.2 KB)
1 |
(********************************************************************) |
---|---|
2 |
(* *) |
3 |
(* The LustreC compiler toolset / The LustreC Development Team *) |
4 |
(* Copyright 2012 - -- ONERA - CNRS - INPT *) |
5 |
(* *) |
6 |
(* LustreC is free software, distributed WITHOUT ANY WARRANTY *) |
7 |
(* under the terms of the GNU Lesser General Public License *) |
8 |
(* version 2.1. *) |
9 |
(* *) |
10 |
(********************************************************************) |
11 |
|
12 |
open Corelang |
13 |
open LustreSpec |
14 |
|
15 |
(* Consts unfoooolding *) |
16 |
let is_const i consts = |
17 |
List.exists (fun c -> c.const_id = i) consts |
18 |
|
19 |
let get_const i consts = |
20 |
let c = List.find (fun c -> c.const_id = i) consts in |
21 |
c.const_value |
22 |
|
23 |
let rec expr_unfold_consts consts e = |
24 |
{ e with expr_desc = expr_desc_unfold_consts consts e.expr_desc e.expr_type } |
25 |
|
26 |
and expr_desc_unfold_consts consts e e_type = |
27 |
let unfold = expr_unfold_consts consts in |
28 |
match e with |
29 |
| Expr_const _ -> e |
30 |
| Expr_ident i -> if is_const i consts && not (Types.is_array_type e_type) then Expr_const (get_const i consts) else e |
31 |
| Expr_array el -> Expr_array (List.map unfold el) |
32 |
| Expr_access (e1, d) -> Expr_access (unfold e1, d) |
33 |
| Expr_power (e1, d) -> Expr_power (unfold e1, d) |
34 |
| Expr_tuple el -> Expr_tuple (List.map unfold el) |
35 |
| Expr_ite (c, t, e) -> Expr_ite (unfold c, unfold t, unfold e) |
36 |
| Expr_arrow (e1, e2)-> Expr_arrow (unfold e1, unfold e2) |
37 |
| Expr_fby (e1, e2) -> Expr_fby (unfold e1, unfold e2) |
38 |
(* | Expr_concat (e1, e2) -> Expr_concat (unfold e1, unfold e2) *) |
39 |
(* | Expr_tail e' -> Expr_tail (unfold e') *) |
40 |
| Expr_pre e' -> Expr_pre (unfold e') |
41 |
| Expr_when (e', i, l)-> Expr_when (unfold e', i, l) |
42 |
| Expr_merge (i, hl) -> Expr_merge (i, List.map (fun (t, h) -> (t, unfold h)) hl) |
43 |
| Expr_appl (i, e', i') -> Expr_appl (i, unfold e', i') |
44 |
|
45 |
let eq_unfold_consts consts eq = |
46 |
{ eq with eq_rhs = expr_unfold_consts consts eq.eq_rhs } |
47 |
|
48 |
let node_unfold_consts consts node = |
49 |
{ node with node_eqs = List.map (eq_unfold_consts consts) node.node_eqs } |
50 |
|
51 |
let prog_unfold_consts prog = |
52 |
let consts = List.map const_of_top (get_consts prog) in |
53 |
List.map ( |
54 |
fun decl -> match decl.top_decl_desc with |
55 |
| Node nd -> {decl with top_decl_desc = Node (node_unfold_consts consts nd)} |
56 |
| _ -> decl |
57 |
) prog |
58 |
|
59 |
let apply_stack expr stack = |
60 |
List.fold_left (fun expr (v, t) -> mkexpr expr.expr_loc (Expr_when (expr, v, t))) expr stack |
61 |
|
62 |
let expr_distribute_when expr = |
63 |
let rec distrib stack expr = |
64 |
match expr.expr_desc with |
65 |
| Expr_const _ |
66 |
| Expr_ident _ |
67 |
| Expr_arrow _ |
68 |
| Expr_fby _ |
69 |
| Expr_pre _ |
70 |
-> apply_stack expr stack |
71 |
| Expr_appl (id, _, _) when not (Stateless.check_node (node_from_name id)) |
72 |
-> apply_stack expr stack |
73 |
| Expr_ite (c, t, e) |
74 |
-> let cid = ident_of_expr c in |
75 |
mkexpr expr.expr_loc |
76 |
(Expr_merge (cid, |
77 |
[(tag_true , distrib ((cid,tag_true )::stack) t); |
78 |
(tag_false, distrib ((cid,tag_false)::stack) e)])) |
79 |
| Expr_array el -> { expr with expr_desc = (Expr_array (List.map (distrib stack) el)) } |
80 |
| Expr_access (e1, d) -> { expr with expr_desc = Expr_access (distrib stack e1, d) } |
81 |
| Expr_power (e1, d) -> { expr with expr_desc = Expr_power (distrib stack e1, d) } |
82 |
| Expr_tuple el -> { expr with expr_desc = Expr_tuple (List.map (distrib stack) el) } |
83 |
| Expr_when (e', i, l)-> distrib ((i, l)::stack) e' |
84 |
| Expr_merge (i, hl) -> { expr with expr_desc = Expr_merge (i, List.map (fun (t, h) -> (t, distrib stack h)) hl) } |
85 |
| Expr_appl (id, e', i') -> { expr with expr_desc = Expr_appl (id, distrib stack e', i')} |
86 |
in distrib [] expr |
87 |
|
88 |
let eq_distribute_when eq = |
89 |
{ eq with eq_rhs = expr_distribute_when eq.eq_rhs } |
90 |
|
91 |
let node_distribute_when node = |
92 |
{ node with node_eqs = List.map eq_distribute_when node.node_eqs } |
93 |
|
94 |
let prog_distribute_when prog = |
95 |
List.map ( |
96 |
fun decl -> match decl.top_decl_desc with |
97 |
| Node nd -> {decl with top_decl_desc = Node (node_distribute_when nd)} |
98 |
| _ -> decl |
99 |
) prog |
100 |
(* Local Variables: *) |
101 |
(* compile-command:"make -C .." *) |
102 |
(* End: *) |