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 Utils
|
13
|
open Lustre_types
|
14
|
open Corelang
|
15
|
open Causality
|
16
|
open Scheduling_type
|
17
|
|
18
|
(* Topological sort with a priority for variables belonging in the same equation
|
19
|
lhs. For variables still unrelated, standard compare is used to choose the
|
20
|
minimal element. This priority is used since it helps a lot in factorizing
|
21
|
generated code. Moreover, the dependency graph is browsed in a depth-first
|
22
|
manner whenever possible, to improve the behavior of optimization algorithms
|
23
|
applied in forthcoming compilation steps. In the following functions: -
|
24
|
[eq_equiv] is the equivalence relation between vars of the same equation lhs
|
25
|
- [g] the (imperative) graph to be topologically sorted - [pending] is the
|
26
|
set of unsorted root variables so far, equivalent to the last sorted var -
|
27
|
[frontier] is the set of unsorted root variables so far, not belonging in
|
28
|
[pending] - [sort] is the resulting topological order *)
|
29
|
|
30
|
(* Checks whether the currently scheduled variable [choice] is an output of a
|
31
|
call, possibly among others *)
|
32
|
let is_call_output choice g =
|
33
|
List.exists ExprDep.is_instance_var (IdentDepGraph.succ g choice)
|
34
|
|
35
|
(* Adds successors of [v] in graph [g] in [pending] or [frontier] sets, wrt
|
36
|
[eq_equiv], then removes [v] from [g] *)
|
37
|
let add_successors eq_equiv g v pending frontier =
|
38
|
let succs_v = IdentDepGraph.succ g v in
|
39
|
IdentDepGraph.remove_vertex g v;
|
40
|
List.iter
|
41
|
(fun v' ->
|
42
|
if is_graph_root v' g then
|
43
|
if eq_equiv v v' then pending := ISet.add v' !pending
|
44
|
else frontier := ISet.add v' !frontier)
|
45
|
succs_v
|
46
|
|
47
|
(* Chooses the next var to be sorted, taking priority into account. Modifies
|
48
|
[pending] and [frontier] accordingly. *)
|
49
|
let next_element eq_equiv g sort call pending frontier =
|
50
|
if ISet.is_empty !pending then (
|
51
|
let choice = ISet.min_elt !frontier in
|
52
|
(*Format.eprintf "-1-> %s@." choice;*)
|
53
|
frontier := ISet.remove choice !frontier;
|
54
|
let p, f = ISet.partition (eq_equiv choice) !frontier in
|
55
|
pending := p;
|
56
|
frontier := f;
|
57
|
call := is_call_output choice g;
|
58
|
add_successors eq_equiv g choice pending frontier;
|
59
|
if not (ExprDep.is_ghost_var choice) then sort := [ choice ] :: !sort)
|
60
|
else
|
61
|
let choice = ISet.min_elt !pending in
|
62
|
(*Format.eprintf "-2-> %s@." choice;*)
|
63
|
pending := ISet.remove choice !pending;
|
64
|
add_successors eq_equiv g choice pending frontier;
|
65
|
if not (ExprDep.is_ghost_var choice) then
|
66
|
sort :=
|
67
|
if !call then (choice :: List.hd !sort) :: List.tl !sort
|
68
|
else [ choice ] :: !sort
|
69
|
|
70
|
(* Topological sort of dependency graph [g], with priority. *)
|
71
|
let topological_sort eq_equiv g =
|
72
|
let roots = graph_roots g in
|
73
|
assert (roots <> []);
|
74
|
let call = ref false in
|
75
|
let frontier = ref (List.fold_right ISet.add roots ISet.empty) in
|
76
|
let pending = ref ISet.empty in
|
77
|
let sorted = ref [] in
|
78
|
while not (ISet.is_empty !frontier && ISet.is_empty !pending) do
|
79
|
(*Format.eprintf "frontier = {%a}, pending = {%a}@." (fun fmt -> ISet.iter
|
80
|
(fun e -> Format.pp_print_string fmt e)) !frontier (fun fmt -> ISet.iter
|
81
|
(fun e -> Format.pp_print_string fmt e)) !pending;*)
|
82
|
next_element eq_equiv g sorted call pending frontier
|
83
|
done;
|
84
|
IdentDepGraph.clear g;
|
85
|
!sorted
|
86
|
|
87
|
(* Filters out normalization variables and renames instance variables to keep
|
88
|
things readable, in a case of a dependency error *)
|
89
|
let filter_original n vl =
|
90
|
List.fold_right
|
91
|
(fun v res ->
|
92
|
if ExprDep.is_instance_var v then
|
93
|
Format.sprintf "node %s" (ExprDep.undo_instance_var v) :: res
|
94
|
else
|
95
|
let vdecl = get_node_var v n in
|
96
|
if vdecl.var_orig then v :: res else res)
|
97
|
vl []
|
98
|
|
99
|
let eq_equiv eq_equiv_hash v1 v2 =
|
100
|
try Hashtbl.find eq_equiv_hash v1 = Hashtbl.find eq_equiv_hash v2
|
101
|
with Not_found -> false
|
102
|
|
103
|
let schedule_node n =
|
104
|
(* let node_vars = get_node_vars n in *)
|
105
|
Log.report ~level:5 (fun fmt ->
|
106
|
Format.fprintf fmt "scheduling node %s@ " n.node_id);
|
107
|
let eq_equiv = eq_equiv (ExprDep.node_eq_equiv n) in
|
108
|
|
109
|
let node, g = global_dependency n in
|
110
|
|
111
|
(* TODO X: extend the graph with inputs (adapt the causality analysis to deal
|
112
|
with inputs compute: coi predecessors of outputs warning (no modification)
|
113
|
when memories are non used (do not impact output) or when inputs are not
|
114
|
used (do not impact output) DONE ! *)
|
115
|
let dep_graph = IdentDepGraph.copy g in
|
116
|
let schedule = topological_sort eq_equiv g in
|
117
|
let unused_vars = Liveness.compute_unused_variables n dep_graph in
|
118
|
let fanin_table = Liveness.compute_fanin n dep_graph in
|
119
|
{ node; schedule; unused_vars; fanin_table; dep_graph }
|
120
|
|
121
|
(* let schedule_eqs eqs =
|
122
|
* let eq_equiv = eq_equiv (ExprDep.eqs_eq_equiv eqs) in
|
123
|
* assert false (\* TODO: continue to implement scheduling of eqs for spec *\) *)
|
124
|
|
125
|
let compute_node_reuse_table report =
|
126
|
let disjoint = Disjunction.clock_disjoint_map (get_node_vars report.node) in
|
127
|
let reuse =
|
128
|
Liveness.compute_reuse_policy report.node report.schedule disjoint
|
129
|
report.dep_graph
|
130
|
in
|
131
|
(* if !Options.print_reuse then begin Log.report ~level:0 (fun fmt ->
|
132
|
Format.fprintf fmt "OPT:%B@." (try (Hashtbl.iter (fun s1 v2 -> if s1 =
|
133
|
v2.var_id then raise Not_found) reuse; false) with Not_found -> true) );
|
134
|
Log.report ~level:0 (fun fmt -> Format.fprintf fmt "OPT:clock disjoint map
|
135
|
for node %s: %a" n'.node_id Disjunction.pp_disjoint_map disjoint );
|
136
|
Log.report ~level:0 (fun fmt -> Format.fprintf fmt "OPT:reuse policy for
|
137
|
node %s: %a" n'.node_id Liveness.pp_reuse_policy reuse ); end; *)
|
138
|
reuse
|
139
|
|
140
|
let schedule_prog prog =
|
141
|
List.fold_right
|
142
|
(fun top_decl (accu_prog, sch_map) ->
|
143
|
match top_decl.top_decl_desc with
|
144
|
| Node nd ->
|
145
|
let report = schedule_node nd in
|
146
|
( { top_decl with top_decl_desc = Node report.node } :: accu_prog,
|
147
|
IMap.add nd.node_id report sch_map )
|
148
|
| _ ->
|
149
|
top_decl :: accu_prog, sch_map)
|
150
|
prog ([], IMap.empty)
|
151
|
|
152
|
let compute_prog_reuse_table report = IMap.map compute_node_reuse_table report
|
153
|
|
154
|
(* removes inlined local variables from schedule report, which are now useless *)
|
155
|
let remove_node_inlined_locals locals report =
|
156
|
let is_inlined v = IMap.exists (fun l _ -> v = l) locals in
|
157
|
let schedule' =
|
158
|
List.fold_right
|
159
|
(fun heads q ->
|
160
|
let heads' = List.filter (fun v -> not (is_inlined v)) heads in
|
161
|
if heads' = [] then q else heads' :: q)
|
162
|
report.schedule []
|
163
|
in
|
164
|
IMap.iter (fun v _ -> Hashtbl.remove report.fanin_table v) locals;
|
165
|
IMap.iter
|
166
|
(fun v _ ->
|
167
|
let iv = ExprDep.mk_instance_var v in
|
168
|
Liveness.replace_in_dep_graph v iv report.dep_graph)
|
169
|
locals;
|
170
|
{ report with schedule = schedule' }
|
171
|
|
172
|
let remove_prog_inlined_locals removed reuse =
|
173
|
IMap.mapi (fun id -> remove_node_inlined_locals (IMap.find id removed)) reuse
|
174
|
|
175
|
let pp_eq_schedule fmt vl =
|
176
|
match vl with
|
177
|
| [] ->
|
178
|
assert false
|
179
|
| [ v ] ->
|
180
|
Format.fprintf fmt "%s" v
|
181
|
| _ ->
|
182
|
Format.fprintf fmt "(%a)"
|
183
|
(fprintf_list ~sep:" , " (fun fmt v -> Format.fprintf fmt "%s" v))
|
184
|
vl
|
185
|
|
186
|
let pp_schedule fmt node_schs =
|
187
|
IMap.iter
|
188
|
(fun nd report ->
|
189
|
Format.(
|
190
|
fprintf fmt "%s schedule: %a@ " nd
|
191
|
(pp_print_list ~pp_sep:pp_print_semicolon pp_eq_schedule)
|
192
|
report.schedule))
|
193
|
node_schs
|
194
|
|
195
|
let pp_fanin_table fmt node_schs =
|
196
|
IMap.iter
|
197
|
(fun nd report ->
|
198
|
Format.fprintf fmt "%s: %a@ " nd Liveness.pp_fanin report.fanin_table)
|
199
|
node_schs
|
200
|
|
201
|
let pp_dep_graph fmt node_schs =
|
202
|
IMap.iter
|
203
|
(fun nd report ->
|
204
|
Format.fprintf fmt "%s dependency graph: %a@ " nd pp_dep_graph
|
205
|
report.dep_graph)
|
206
|
node_schs
|
207
|
|
208
|
let pp_warning_unused fmt node_schs =
|
209
|
IMap.iter
|
210
|
(fun nd report ->
|
211
|
let unused = report.unused_vars in
|
212
|
if not (ISet.is_empty unused) then
|
213
|
let nd =
|
214
|
match (Corelang.node_from_name nd).top_decl_desc with
|
215
|
| Node nd ->
|
216
|
nd
|
217
|
| _ ->
|
218
|
assert false
|
219
|
in
|
220
|
ISet.iter
|
221
|
(fun u ->
|
222
|
let vu = get_node_var u nd in
|
223
|
if vu.var_orig then
|
224
|
Format.fprintf fmt
|
225
|
" Warning: variable '%s' seems unused@, %a@,@," u
|
226
|
Location.pp_loc vu.var_loc)
|
227
|
unused)
|
228
|
node_schs
|
229
|
|
230
|
(* Sort eqs according to schedule *)
|
231
|
(* Sort the set of equations of node [nd] according to the computed schedule
|
232
|
[sch] *)
|
233
|
let sort_equations_from_schedule eqs sch =
|
234
|
Log.report ~level:10 (fun fmt ->
|
235
|
Format.fprintf fmt "schedule: %a@ "
|
236
|
(Format.pp_print_list ~pp_sep:Format.pp_print_semicolon pp_eq_schedule)
|
237
|
sch);
|
238
|
let split_eqs = Splitting.tuple_split_eq_list eqs in
|
239
|
(* Flatten schedule *)
|
240
|
let sch =
|
241
|
List.fold_right (fun vl res -> List.map (fun v -> [ v ]) vl @ res) sch []
|
242
|
in
|
243
|
let eqs_rev, remainder =
|
244
|
List.fold_left
|
245
|
(fun (accu, node_eqs_remainder) vl ->
|
246
|
(* For each variable in vl, there should exists the equations in accu *)
|
247
|
if
|
248
|
List.for_all
|
249
|
(fun v -> List.exists (fun eq -> List.mem v eq.eq_lhs) accu)
|
250
|
vl
|
251
|
then accu, node_eqs_remainder
|
252
|
else
|
253
|
let eq_v, remainder = find_eq vl node_eqs_remainder in
|
254
|
eq_v :: accu, remainder)
|
255
|
([], split_eqs) sch
|
256
|
in
|
257
|
let eqs = List.rev eqs_rev in
|
258
|
let unused =
|
259
|
if List.length remainder > 0 then (
|
260
|
Log.report ~level:3 (fun fmt ->
|
261
|
Format.fprintf fmt
|
262
|
"[Warning] Equations not used are@ %a@ Full equation set is:@ %a@ "
|
263
|
Printers.pp_node_eqs remainder Printers.pp_node_eqs eqs);
|
264
|
let vars =
|
265
|
List.fold_left (fun accu eq -> eq.eq_lhs @ accu) [] remainder
|
266
|
in
|
267
|
Log.report ~level:1 (fun fmt ->
|
268
|
Format.fprintf fmt "[Warning] Unused variables: %a@ "
|
269
|
(fprintf_list ~sep:", " Format.pp_print_string)
|
270
|
vars);
|
271
|
vars)
|
272
|
else []
|
273
|
in
|
274
|
eqs, unused
|
275
|
|
276
|
(* Local Variables: *)
|
277
|
(* compile-command:"make -C .." *)
|
278
|
(* End: *)
|