1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Fu Yong Quah, Jane Street Europe *)
(* *)
(* Copyright 2017 Jane Street Group LLC *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
[@@@ocaml.warning "+a-4-9-30-40-41-42"]
module A = Simple_value_approx
type queue_elem =
| Q_symbol of Symbol.t
| Q_set_of_closures_id of Set_of_closures_id.t
| Q_export_id of Export_id.t
type symbols_to_export =
{ symbols : Symbol.Set.t;
export_ids : Export_id.Set.t;
set_of_closure_ids : Set_of_closures_id.Set.t;
set_of_closure_ids_keep_declaration : Set_of_closures_id.Set.t;
relevant_imported_closure_ids : Closure_id.Set.t;
relevant_local_closure_ids : Closure_id.Set.t;
relevant_imported_vars_within_closure : Var_within_closure.Set.t;
relevant_local_vars_within_closure : Var_within_closure.Set.t;
}
let traverse
~(sets_of_closures_map :
Flambda.set_of_closures Set_of_closures_id.Map.t)
~(closure_id_to_set_of_closures_id :
Set_of_closures_id.t Closure_id.Map.t)
~(function_declarations_map :
A.function_declarations Set_of_closures_id.Map.t)
~(values : Export_info.descr Export_id.Map.t)
~(symbol_id : Export_id.t Symbol.Map.t)
~(root_symbol: Symbol.t) =
let relevant_set_of_closures_declaration_only =
ref Set_of_closures_id.Set.empty
in
let relevant_symbols = ref (Symbol.Set.singleton root_symbol) in
let relevant_set_of_closures = ref Set_of_closures_id.Set.empty in
let relevant_export_ids = ref Export_id.Set.empty in
let relevant_imported_closure_ids = ref Closure_id.Set.empty in
let relevant_local_closure_ids = ref Closure_id.Set.empty in
let relevant_imported_vars_within_closure =
ref Var_within_closure.Set.empty
in
let relevant_local_vars_with_closure = ref Var_within_closure.Set.empty in
let (queue : queue_elem Queue.t) = Queue.create () in
let conditionally_add_symbol symbol =
if not (Symbol.Set.mem symbol !relevant_symbols) then begin
relevant_symbols :=
Symbol.Set.add symbol !relevant_symbols;
Queue.add (Q_symbol symbol) queue
end
in
let conditionally_add_set_of_closures_id set_of_closures_id =
if not (Set_of_closures_id.Set.mem
set_of_closures_id !relevant_set_of_closures) then begin
relevant_set_of_closures :=
Set_of_closures_id.Set.add set_of_closures_id
!relevant_set_of_closures;
Queue.add (Q_set_of_closures_id set_of_closures_id) queue
end
in
let conditionally_add_export_id export_id =
if not (Export_id.Set.mem export_id !relevant_export_ids) then begin
relevant_export_ids :=
Export_id.Set.add export_id !relevant_export_ids;
Queue.add (Q_export_id export_id) queue
end
in
let process_approx (approx : Export_info.approx) =
match approx with
| Value_id export_id ->
conditionally_add_export_id export_id
| Value_symbol symbol ->
conditionally_add_symbol symbol
| Value_unknown -> ()
in
let process_value_set_of_closures
(soc : Export_info.value_set_of_closures) =
conditionally_add_set_of_closures_id soc.set_of_closures_id;
Var_within_closure.Map.iter
(fun _ value -> process_approx value) soc.bound_vars;
Closure_id.Map.iter
(fun _ value -> process_approx value) soc.results;
begin match soc.aliased_symbol with
| None -> ()
| Some symbol -> conditionally_add_symbol symbol
end
in
let process_function_body (function_body : A.function_body) =
Flambda_iterators.iter
(fun (term : Flambda.t) ->
match term with
| Flambda.Apply { kind ; _ } ->
begin match kind with
| Indirect -> ()
| Direct closure_id ->
begin match
Closure_id.Map.find
closure_id
closure_id_to_set_of_closures_id
with
| exception Not_found ->
relevant_imported_closure_ids :=
Closure_id.Set.add closure_id
!relevant_imported_closure_ids
| set_of_closures_id ->
relevant_local_closure_ids :=
Closure_id.Set.add closure_id
!relevant_local_closure_ids;
conditionally_add_set_of_closures_id
set_of_closures_id
end
end
| _ -> ())
(fun (named : Flambda.named) ->
let process_closure_id closure_id =
match
Closure_id.Map.find closure_id closure_id_to_set_of_closures_id
with
| exception Not_found ->
relevant_imported_closure_ids :=
Closure_id.Set.add closure_id !relevant_imported_closure_ids
| set_of_closure_id ->
relevant_local_closure_ids :=
Closure_id.Set.add closure_id !relevant_local_closure_ids;
relevant_set_of_closures_declaration_only :=
Set_of_closures_id.Set.add
set_of_closure_id
!relevant_set_of_closures_declaration_only
in
match named with
| Symbol symbol
| Read_symbol_field (symbol, _) ->
conditionally_add_symbol symbol
| Set_of_closures soc ->
conditionally_add_set_of_closures_id
soc.function_decls.set_of_closures_id
| Project_closure { closure_id; _ } ->
process_closure_id closure_id
| Move_within_set_of_closures { start_from; move_to; _ } ->
process_closure_id start_from;
process_closure_id move_to
| Project_var { closure_id ; var; _ } ->
begin match
Closure_id.Map.find
closure_id closure_id_to_set_of_closures_id
with
| exception Not_found ->
relevant_imported_closure_ids :=
Closure_id.Set.add closure_id
!relevant_imported_closure_ids;
relevant_imported_vars_within_closure :=
Var_within_closure.Set.add var
!relevant_imported_vars_within_closure
| set_of_closure_id ->
relevant_local_closure_ids :=
Closure_id.Set.add closure_id
!relevant_local_closure_ids;
relevant_local_vars_with_closure :=
Var_within_closure.Set.add var
!relevant_local_vars_with_closure;
relevant_set_of_closures_declaration_only :=
Set_of_closures_id.Set.add
set_of_closure_id
!relevant_set_of_closures_declaration_only
end
| Prim _
| Expr _
| Const _
| Allocated_const _
| Read_mutable _ -> ())
function_body.body
in
let rec loop () =
if Queue.is_empty queue then
()
else begin
begin match Queue.pop queue with
| Q_export_id export_id ->
begin match Export_id.Map.find export_id values with
| exception Not_found -> ()
| Value_block (_, approxes) ->
Array.iter process_approx approxes
| Value_closure value_closure ->
process_value_set_of_closures value_closure.set_of_closures
| Value_set_of_closures soc ->
process_value_set_of_closures soc
| _ -> ()
end
| Q_symbol symbol ->
let compilation_unit = Symbol.compilation_unit symbol in
if Compilation_unit.is_current compilation_unit then begin
match Symbol.Map.find symbol symbol_id with
| exception Not_found ->
Misc.fatal_errorf "cannot find symbol's export id %a\n"
Symbol.print symbol
| export_id ->
conditionally_add_export_id export_id
end
| Q_set_of_closures_id set_of_closures_id ->
begin match
Set_of_closures_id.Map.find
set_of_closures_id function_declarations_map
with
| exception Not_found -> ()
| function_declarations ->
Variable.Map.iter
(fun (_ : Variable.t) (fun_decl : A.function_declaration) ->
match fun_decl.function_body with
| None -> ()
| Some function_body -> process_function_body function_body)
function_declarations.funs
end
end;
loop ()
end
in
Queue.add (Q_symbol root_symbol) queue;
loop ();
Closure_id.Map.iter (fun closure_id set_of_closure_id ->
if Set_of_closures_id.Set.mem
set_of_closure_id !relevant_set_of_closures
then begin
relevant_local_closure_ids :=
Closure_id.Set.add closure_id !relevant_local_closure_ids
end)
closure_id_to_set_of_closures_id;
Set_of_closures_id.Set.iter (fun set_of_closures_id ->
match
Set_of_closures_id.Map.find set_of_closures_id sets_of_closures_map
with
| exception Not_found -> ()
| set_of_closures ->
Variable.Map.iter (fun var _ ->
relevant_local_vars_with_closure :=
Var_within_closure.Set.add
(Var_within_closure.wrap var)
!relevant_local_vars_with_closure)
set_of_closures.free_vars)
!relevant_set_of_closures;
{ symbols = !relevant_symbols;
export_ids = !relevant_export_ids;
set_of_closure_ids = !relevant_set_of_closures;
set_of_closure_ids_keep_declaration =
!relevant_set_of_closures_declaration_only;
relevant_imported_closure_ids = !relevant_imported_closure_ids;
relevant_local_closure_ids = !relevant_local_closure_ids;
relevant_imported_vars_within_closure =
!relevant_imported_vars_within_closure;
relevant_local_vars_within_closure =
!relevant_local_vars_with_closure;
}
|
