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 Lustre_types
|
13
|
open Corelang
|
14
|
(* open LustreSpec *)
|
15
|
|
16
|
(* Consts unfoooolding *)
|
17
|
let is_const i consts = 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 _ ->
|
30
|
e
|
31
|
| Expr_ident i ->
|
32
|
if is_const i consts && not (Types.is_array_type e_type) then
|
33
|
Expr_const (get_const i consts)
|
34
|
else e
|
35
|
| Expr_array el ->
|
36
|
Expr_array (List.map unfold el)
|
37
|
| Expr_access (e1, d) ->
|
38
|
Expr_access (unfold e1, d)
|
39
|
| Expr_power (e1, d) ->
|
40
|
Expr_power (unfold e1, d)
|
41
|
| Expr_tuple el ->
|
42
|
Expr_tuple (List.map unfold el)
|
43
|
| Expr_ite (c, t, e) ->
|
44
|
Expr_ite (unfold c, unfold t, unfold e)
|
45
|
| Expr_arrow (e1, e2) ->
|
46
|
Expr_arrow (unfold e1, unfold e2)
|
47
|
| Expr_fby (e1, e2) ->
|
48
|
Expr_fby (unfold e1, unfold e2)
|
49
|
(* | Expr_concat (e1, e2) -> Expr_concat (unfold e1, unfold e2) *)
|
50
|
(* | Expr_tail e' -> Expr_tail (unfold e') *)
|
51
|
| Expr_pre e' ->
|
52
|
Expr_pre (unfold e')
|
53
|
| Expr_when (e', i, l) ->
|
54
|
Expr_when (unfold e', i, l)
|
55
|
| Expr_merge (i, hl) ->
|
56
|
Expr_merge (i, List.map (fun (t, h) -> t, unfold h) hl)
|
57
|
| Expr_appl (i, e', i') ->
|
58
|
Expr_appl (i, unfold e', i')
|
59
|
|
60
|
let eq_unfold_consts consts eq =
|
61
|
{ eq with eq_rhs = expr_unfold_consts consts eq.eq_rhs }
|
62
|
|
63
|
let node_unfold_consts consts node =
|
64
|
let eqs, automata = get_node_eqs node in
|
65
|
assert (automata = []);
|
66
|
{
|
67
|
node with
|
68
|
node_stmts = List.map (fun eq -> Eq (eq_unfold_consts consts eq)) eqs;
|
69
|
}
|
70
|
|
71
|
let prog_unfold_consts prog =
|
72
|
let consts = List.map const_of_top (get_consts prog) in
|
73
|
List.map
|
74
|
(fun decl ->
|
75
|
match decl.top_decl_desc with
|
76
|
| Node nd ->
|
77
|
{ decl with top_decl_desc = Node (node_unfold_consts consts nd) }
|
78
|
| _ ->
|
79
|
decl)
|
80
|
prog
|
81
|
|
82
|
(* Distribution of when inside sub-expressions, i.e. (a+b) when c --> a when c +
|
83
|
b when c May increase clock disjointness of variables, which is useful for
|
84
|
code optimization *)
|
85
|
let apply_stack expr stack =
|
86
|
List.fold_left
|
87
|
(fun expr (v, t) -> mkexpr expr.expr_loc (Expr_when (expr, v, t)))
|
88
|
expr stack
|
89
|
|
90
|
let expr_distribute_when expr =
|
91
|
let rec distrib stack expr =
|
92
|
match expr.expr_desc with
|
93
|
| Expr_const _ | Expr_ident _ | Expr_arrow _ | Expr_fby _ | Expr_pre _ ->
|
94
|
apply_stack expr stack
|
95
|
| Expr_appl (id, _, _) when not (Stateless.check_node (node_from_name id))
|
96
|
->
|
97
|
apply_stack expr stack
|
98
|
| Expr_ite (c, t, e) ->
|
99
|
let cid = ident_of_expr c in
|
100
|
mkexpr expr.expr_loc
|
101
|
(Expr_merge
|
102
|
( cid,
|
103
|
[
|
104
|
tag_true, distrib ((cid, tag_true) :: stack) t;
|
105
|
tag_false, distrib ((cid, tag_false) :: stack) e;
|
106
|
] ))
|
107
|
| Expr_array el ->
|
108
|
{ expr with expr_desc = Expr_array (List.map (distrib stack) el) }
|
109
|
| Expr_access (e1, d) ->
|
110
|
{ expr with expr_desc = Expr_access (distrib stack e1, d) }
|
111
|
| Expr_power (e1, d) ->
|
112
|
{ expr with expr_desc = Expr_power (distrib stack e1, d) }
|
113
|
| Expr_tuple el ->
|
114
|
{ expr with expr_desc = Expr_tuple (List.map (distrib stack) el) }
|
115
|
| Expr_when (e', i, l) ->
|
116
|
distrib ((i, l) :: stack) e'
|
117
|
| Expr_merge (i, hl) ->
|
118
|
{
|
119
|
expr with
|
120
|
expr_desc =
|
121
|
Expr_merge (i, List.map (fun (t, h) -> t, distrib stack h) hl);
|
122
|
}
|
123
|
| Expr_appl (id, e', i') ->
|
124
|
{ expr with expr_desc = Expr_appl (id, distrib stack e', i') }
|
125
|
in
|
126
|
distrib [] expr
|
127
|
|
128
|
let eq_distribute_when eq = { eq with eq_rhs = expr_distribute_when eq.eq_rhs }
|
129
|
|
130
|
let node_distribute_when node =
|
131
|
let eqs, automata = get_node_eqs node in
|
132
|
assert (automata = []);
|
133
|
{ node with node_stmts = List.map (fun eq -> Eq (eq_distribute_when eq)) eqs }
|
134
|
|
135
|
let prog_distribute_when prog =
|
136
|
List.map
|
137
|
(fun decl ->
|
138
|
match decl.top_decl_desc with
|
139
|
| Node nd ->
|
140
|
{ decl with top_decl_desc = Node (node_distribute_when nd) }
|
141
|
| _ ->
|
142
|
decl)
|
143
|
prog
|
144
|
(* Local Variables: *)
|
145
|
(* compile-command:"make -C .." *)
|
146
|
(* End: *)
|