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 Dimension
|
14
|
open Utils
|
15
|
open ISet
|
16
|
module Live = Map.Make (Int)
|
17
|
|
18
|
let pp_live fmt l = Live.bindings
|
19
|
|
20
|
let assigned s eq = union s (of_list eq.eq_lhs)
|
21
|
|
22
|
let rec occur_dim_expr s d =
|
23
|
match d.dim_desc with
|
24
|
| Dident x ->
|
25
|
add x s
|
26
|
| Dappl (_, ds) ->
|
27
|
List.fold_left occur_dim_expr s ds
|
28
|
| Dite (e, t, f) ->
|
29
|
occur_dim_expr (occur_dim_expr (occur_dim_expr s e) t) f
|
30
|
| Dlink d ->
|
31
|
occur_dim_expr s d
|
32
|
| _ ->
|
33
|
s
|
34
|
|
35
|
let rec occur_expr s e =
|
36
|
match e.expr_desc with
|
37
|
| Expr_ident x ->
|
38
|
add x s
|
39
|
| Expr_tuple es | Expr_array es ->
|
40
|
List.fold_left occur_expr s es
|
41
|
| Expr_ite (e, t, f) ->
|
42
|
occur_expr (occur_expr (occur_expr s e) t) f
|
43
|
| Expr_arrow (e1, e2) | Expr_fby (e1, e2) ->
|
44
|
occur_expr (occur_expr s e1) e2
|
45
|
| Expr_access (e, d) | Expr_power (e, d) ->
|
46
|
occur_expr (occur_dim_expr s d) e
|
47
|
| Expr_pre e ->
|
48
|
occur_expr s e
|
49
|
| Expr_when (e, x, _) ->
|
50
|
occur_expr (add x s) e
|
51
|
| Expr_merge (x, les) ->
|
52
|
List.fold_left (fun s (_, e) -> occur_expr s e) (add x s) les
|
53
|
| Expr_appl (_, e, r) ->
|
54
|
occur_expr (match r with Some r -> occur_expr s r | None -> s) e
|
55
|
| _ ->
|
56
|
s
|
57
|
|
58
|
let occur s eq = occur_expr s eq.eq_rhs
|
59
|
|
60
|
let live : (ident, ISet.t Live.t) Hashtbl.t = Hashtbl.create 32
|
61
|
|
62
|
let of_var_decls = List.fold_left (fun s v -> add v.var_id s) empty
|
63
|
|
64
|
let set_live_of nid outputs locals sorted_eqs =
|
65
|
let outputs = of_var_decls outputs in
|
66
|
let locals = of_var_decls locals in
|
67
|
let vars = union locals outputs in
|
68
|
let no_occur_after i =
|
69
|
let occ, _ =
|
70
|
List.fold_left
|
71
|
(fun (s, j) eq -> if j <= i then s, j + 1 else occur s eq, j + 1)
|
72
|
(empty, 0) sorted_eqs
|
73
|
in
|
74
|
diff locals occ
|
75
|
in
|
76
|
let l, _, _ =
|
77
|
List.fold_left
|
78
|
(fun (l, asg, i) eq ->
|
79
|
let asg = inter (assigned asg eq) vars in
|
80
|
let noc = no_occur_after i in
|
81
|
let liv = diff asg noc in
|
82
|
Live.add (i + 1) liv l, asg, i + 1)
|
83
|
(Live.add 0 empty Live.empty, empty, 0)
|
84
|
sorted_eqs
|
85
|
in
|
86
|
Log.report ~level:6 (fun fmt ->
|
87
|
Format.(
|
88
|
fprintf fmt "Live variables of %s: %a@;@;" nid
|
89
|
(pp_print_list ~pp_open_box:pp_open_vbox0 (fun fmt (i, l) ->
|
90
|
fprintf fmt "%i: %a" i pp_iset l))
|
91
|
(Live.bindings l)));
|
92
|
Hashtbl.add live nid l
|
93
|
|
94
|
let live_i nid i = Live.find i (Hashtbl.find live nid)
|
95
|
|
96
|
let inter_live_i_with nid i =
|
97
|
let li = live_i nid i in
|
98
|
List.filter (fun v -> mem v.var_id li)
|
99
|
|
100
|
let existential_vars nid i eq =
|
101
|
let li' = live_i nid (i - 1) in
|
102
|
let li = live_i nid i in
|
103
|
let d = diff (union li' (assigned empty eq)) li in
|
104
|
List.filter (fun v -> mem v.var_id d)
|