Revision ca7ff3f7
Added by LĂ©lio Brun over 1 year ago
src/lustre_live.ml  

13  13 
open Dimension 
14  14 
open Utils 
15  15 
open ISet 
16 
module Live = Map.Make(Int) 

16 
module Live = Map.Make (Int)


17  17  
18 
let pp_live fmt l = 

19 
Live.bindings 

18 
let pp_live fmt l = Live.bindings 

20  19  
21 
let assigned s eq = 

22 
union s (of_list eq.eq_lhs) 

20 
let assigned s eq = union s (of_list eq.eq_lhs) 

23  21  
24  22 
let rec occur_dim_expr s d = 
25  23 
match d.dim_desc with 
...  ...  
31  29 
occur_dim_expr (occur_dim_expr (occur_dim_expr s e) t) f 
32  30 
 Dlink d > 
33  31 
occur_dim_expr s d 
34 
 _ > s 

32 
 _ > 

33 
s 

35  34  
36  35 
let rec occur_expr s e = 
37  36 
match e.expr_desc with 
38  37 
 Expr_ident x > 
39  38 
add x s 
40 
 Expr_tuple es 

41 
 Expr_array es > 

39 
 Expr_tuple es  Expr_array es > 

42  40 
List.fold_left occur_expr s es 
43  41 
 Expr_ite (e, t, f) > 
44  42 
occur_expr (occur_expr (occur_expr s e) t) f 
45 
 Expr_arrow (e1, e2) 

46 
 Expr_fby (e1, e2) > 

43 
 Expr_arrow (e1, e2)  Expr_fby (e1, e2) > 

47  44 
occur_expr (occur_expr s e1) e2 
48 
 Expr_access (e, d) 

49 
 Expr_power (e, d) > 

45 
 Expr_access (e, d)  Expr_power (e, d) > 

50  46 
occur_expr (occur_dim_expr s d) e 
51  47 
 Expr_pre e > 
52  48 
occur_expr s e 
...  ...  
56  52 
List.fold_left (fun s (_, e) > occur_expr s e) (add x s) les 
57  53 
 Expr_appl (_, e, r) > 
58  54 
occur_expr (match r with Some r > occur_expr s r  None > s) e 
59 
 _ > s 

55 
 _ > 

56 
s 

60  57  
61 
let occur s eq = 

62 
occur_expr s eq.eq_rhs 

58 
let occur s eq = occur_expr s eq.eq_rhs 

63  59  
64 
let live: (ident, ISet.t Live.t) Hashtbl.t = Hashtbl.create 32 

60 
let live : (ident, ISet.t Live.t) Hashtbl.t = Hashtbl.create 32


65  61  
66 
let of_var_decls = 

67 
List.fold_left (fun s v > add v.var_id s) empty 

62 
let of_var_decls = List.fold_left (fun s v > add v.var_id s) empty 

68  63  
69  64 
let set_live_of nid outputs locals sorted_eqs = 
70  65 
let outputs = of_var_decls outputs in 
71  66 
let locals = of_var_decls locals in 
72  67 
let vars = union locals outputs in 
73  68 
let no_occur_after i = 
74 
let occ, _ = List.fold_left (fun (s, j) eq > 

75 
if j <= i then (s, j + 1) else (occur s eq, j + 1)) 

76 
(empty, 0) sorted_eqs in 

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 

77  74 
diff locals occ 
78  75 
in 
79 
let l, _, _ = List.fold_left (fun (l, asg, i) eq > 

80 
let asg = inter (assigned asg eq) vars in 

81 
let noc = no_occur_after i in 

82 
let liv = diff asg noc in 

83 
Live.add (i + 1) liv l, asg, i + 1) 

84 
(Live.add 0 empty Live.empty, empty, 0) sorted_eqs 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 

85  86 
Log.report ~level:6 (fun fmt > 
86 
Format.(fprintf fmt "Live variables of %s: %a@;@;" nid 

87 
(pp_print_list ~pp_open_box:pp_open_vbox0 

88 
(fun fmt (i, l) > fprintf fmt "%i: %a" i pp_iset l)) 

89 
(Live.bindings l))); 

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))); 

90  92 
Hashtbl.add live nid l 
91  93  
92 
let live_i nid i = 

93 
Live.find i (Hashtbl.find live nid) 

94 
let live_i nid i = Live.find i (Hashtbl.find live nid) 

94  95  
95  96 
let inter_live_i_with nid i = 
96  97 
let li = live_i nid i in 
97  98 
List.filter (fun v > mem v.var_id li) 
98  99  
99  100 
let existential_vars nid i eq = 
100 
let li' = live_i nid (i1) in


101 
let li' = live_i nid (i  1) in


101  102 
let li = live_i nid i in 
102  103 
let d = diff (union li' (assigned empty eq)) li in 
103  104 
List.filter (fun v > mem v.var_id d) 
Also available in: Unified diff
reformatting