Revision 6cf31814 src/scheduling.ml
src/scheduling.ml  

24  24 
(* This module is used for the lustre to C compiler *) 
25  25  
26  26 
open Utils 
27 
open LustreSpec 

27  28 
open Corelang 
28  29 
open Graph 
29  30 
open Causality 
...  ...  
63  64 
Modifies [pending] and [frontier] accordingly. 
64  65 
*) 
65  66 
let next_element eq_equiv g sort pending frontier = 
66 
if ISet.is_empty !pending 

67 
then 

68 
begin 

69 
let choice = ISet.min_elt !frontier in 

67 
begin 

68 
if ISet.is_empty !pending 

69 
then 

70 
begin 

71 
let choice = ISet.min_elt !frontier in 

70  72 
(*Format.eprintf "1> %s@." choice;*) 
71 
frontier := ISet.remove choice !frontier;


72 
let (p, f) = ISet.partition (eq_equiv choice) !frontier in


73 
pending := p;


74 
frontier := f;


75 
add_successors eq_equiv g choice pending frontier;


76 
if not (ExprDep.is_instance_var choice) then sort := choice :: !sort;


77 
end 

78 
else 

79 
begin 

80 
let choice = ISet.min_elt !pending in


73 
frontier := ISet.remove choice !frontier;


74 
let (p, f) = ISet.partition (eq_equiv choice) !frontier in


75 
pending := p;


76 
frontier := f;


77 
add_successors eq_equiv g choice pending frontier;


78 
if not (ExprDep.is_instance_var choice) then sort := choice :: !sort


79 
end


80 
else


81 
begin


82 
let choice = ISet.min_elt !pending in


81  83 
(*Format.eprintf "2> %s@." choice;*) 
82 
pending := ISet.remove choice !pending; 

83 
add_successors eq_equiv g choice pending frontier; 

84 
if not (ExprDep.is_instance_var choice) then sort := choice :: !sort; 

85 
end 

84 
pending := ISet.remove choice !pending; 

85 
add_successors eq_equiv g choice pending frontier; 

86 
if not (ExprDep.is_instance_var choice) then sort := choice :: !sort 

87 
end 

88 
end 

89  
86  90  
87  91 
(* Topological sort of dependency graph [g], with priority. 
88  92 
*) 
...  ...  
100  104 
(fun fmt > ISet.iter (fun e > Format.pp_print_string fmt e)) !pending;*) 
101  105 
next_element eq_equiv g sorted pending frontier; 
102  106 
done; 
107 
IdentDepGraph.clear g; 

103  108 
!sorted 
104  109 
end 
105  110  
111 
(* Computes the last dependency 

112 
*) 

113  
114 
(* Computes the death table of [node] wrt dep graph [g] and topological [sort]. 

115 
The death table is a mapping: ident > Set(ident) such that: 

116 
death x is the set of local variables which get dead (i.e. unused) 

117 
after x is evaluated, but were until live. 

118 
*) 

119 
let death_table node g sort = 

120 
let death = Hashtbl.create 23 in 

121 
let sort = ref (List.rev sort) in 

122 
let buried = ref ISet.empty in 

123 
begin 

124 
buried := ExprDep.node_memory_variables node; 

125 
buried := List.fold_left (fun dead (v : var_decl) > ISet.add v.var_id dead) !buried node.node_outputs; 

126 
(* We could also try to reuse input variables, due to C parameter copying semantics *) 

127 
buried := List.fold_left (fun dead (v : var_decl) > ISet.add v.var_id dead) !buried node.node_inputs; 

128 
while (!sort <> []) 

129 
do 

130 
let head = List.hd !sort in 

131 
let dead = IdentDepGraph.fold_succ 

132 
(fun tgt dead > if not (ExprDep.is_instance_var tgt  ISet.mem tgt !buried) then ISet.add tgt dead else dead) 

133 
g head ISet.empty in 

134 
buried := ISet.union !buried dead; 

135 
Hashtbl.add death head dead; 

136 
sort := List.tl !sort 

137 
done; 

138 
IdentDepGraph.clear g; 

139 
death 

140 
end 

141  
142 
let pp_death_table fmt death = 

143 
begin 

144 
Format.fprintf fmt "{ /* death table */@."; 

145 
Hashtbl.iter (fun s t > Format.fprintf fmt "%s > { %a }@." s (Utils.fprintf_list ~sep:", " Format.pp_print_string) (ISet.elements t)) death; 

146 
Format.fprintf fmt "}@." 

147 
end 

148  
106  149 
let schedule_node n = 
107  150 
try 
108  151 
let eq_equiv = ExprDep.node_eq_equiv n in 
...  ...  
111  154 
Hashtbl.find eq_equiv v1 = Hashtbl.find eq_equiv v2 
112  155 
with Not_found > false in 
113  156 
let n', g = global_dependency n in 
114 
n', topological_sort eq_equiv g 

157 
Log.report ~level:5 (fun fmt > Format.eprintf "dependency graph for node %s: %a" n'.node_id pp_dep_graph g); 

158 
let gg = IdentDepGraph.copy g in 

159 
let sort = topological_sort eq_equiv g in 

160 
let death = death_table n gg sort in 

161 
Log.report ~level:5 (fun fmt > Format.eprintf "death table for node %s: %a" n'.node_id pp_death_table death); 

162 
n', sort, death 

115  163 
(* let sorted = TopologicalDepGraph.fold (fun x res > if ExprDep.is_instance_var x then res else x::res) g []*) 
116  164 
with (Causality.Cycle v) as exc > 
117  165 
pp_error Format.err_formatter v; 
Also available in: Unified diff