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
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Pierre Chambart, OCamlPro *)
(* Mark Shinwell and Leo White, Jane Street Europe *)
(* *)
(* Copyright 2013--2016 OCamlPro SAS *)
(* Copyright 2014--2016 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-66"]
open! Int_replace_polymorphic_compare
module B = Inlining_cost.Benefit
module E = Inline_and_simplify_aux.Env
module R = Inline_and_simplify_aux.Result
module A = Simple_value_approx
let new_var name =
Variable.create name
~current_compilation_unit:(Compilation_unit.get_current_exn ())
(** Fold over all variables bound by the given closure, which is bound to the
variable [lhs_of_application], and corresponds to the given
[function_decls]. Each variable bound by the closure is passed to the
user-specified function as an [Flambda.named] value that projects the
variable from its closure. *)
let fold_over_projections_of_vars_bound_by_closure ~closure_id_being_applied
~lhs_of_application ~bound_variables ~init ~f =
Variable.Set.fold (fun var acc ->
let expr : Flambda.named =
Project_var {
closure = lhs_of_application;
closure_id = closure_id_being_applied;
var = Var_within_closure.wrap var;
}
in
f ~acc ~var ~expr)
bound_variables
init
let set_inline_attribute_on_all_apply body inline specialise =
Flambda_iterators.map_toplevel_expr (function
| Apply apply -> Apply { apply with inline; specialise }
| expr -> expr)
body
(** Assign fresh names for a function's parameters and rewrite the body to
use these new names. *)
let copy_of_function's_body_with_freshened_params env
~(function_decl : A.function_declaration)
~(function_body : A.function_body) =
let params = function_decl.params in
let param_vars = Parameter.List.vars params in
(* We cannot avoid the substitution in the case where we are inlining
inside the function itself. This can happen in two ways: either
(a) we are inlining the function itself directly inside its declaration;
or (b) we are inlining the function into an already-inlined copy.
For (a) we cannot short-cut the substitution by freshening since the
original [params] may still be referenced; for (b) we cannot do it
either since the freshening may already be renaming the parameters for
the first inlining of the function. *)
if E.does_not_bind env param_vars
&& E.does_not_freshen env param_vars
then
params, function_body.body
else
let freshened_params = List.map (fun p -> Parameter.rename p) params in
let subst =
Variable.Map.of_list
(List.combine param_vars (Parameter.List.vars freshened_params))
in
let body = Flambda_utils.toplevel_substitution subst function_body.body in
freshened_params, body
(* CR-soon mshinwell: Add a note somewhere to explain why "bound by the closure"
does not include the function identifiers for other functions in the same
set of closures.
mshinwell: The terminology may be used inconsistently. *)
(** Inline a function by copying its body into a context where it becomes
closed. That is to say, we bind the free variables of the body
(= "variables bound by the closure"), and any function identifiers
introduced by the corresponding set of closures. *)
let inline_by_copying_function_body ~env ~r
~lhs_of_application
~(inline_requested : Lambda.inline_attribute)
~(specialise_requested : Lambda.specialise_attribute)
~closure_id_being_applied
~(function_decl : A.function_declaration)
~(function_body : A.function_body)
~fun_vars
~args ~dbg ~simplify =
assert (E.mem env lhs_of_application);
assert (List.for_all (E.mem env) args);
let r =
if function_body.stub then r
else R.map_benefit r B.remove_call
in
let freshened_params, body =
copy_of_function's_body_with_freshened_params env
~function_decl ~function_body
in
let body =
let default_inline =
Lambda.equal_inline_attribute inline_requested Default_inline
in
let default_specialise =
Lambda.equal_specialise_attribute specialise_requested Default_specialise
in
if function_body.stub
&& ((not default_inline) || (not default_specialise)) then
(* When the function inlined function is a stub, the annotation
is reported to the function applications inside the stub.
This allows to report the annotation to the application the
original programmer really intended: the stub is not visible
in the source. *)
set_inline_attribute_on_all_apply body
inline_requested specialise_requested
else
body
in
let bindings_for_params_to_args =
(* Bind the function's parameters to the arguments from the call site. *)
let args = List.map (fun arg -> Flambda.Expr (Var arg)) args in
Flambda_utils.bind ~body
~bindings:(List.combine (Parameter.List.vars freshened_params) args)
in
(* Add bindings for the variables bound by the closure. *)
let bindings_for_vars_bound_by_closure_and_params_to_args =
let bound_variables =
let params = Parameter.Set.vars function_decl.params in
Variable.Set.diff
(Variable.Set.diff function_body.free_variables params)
fun_vars
in
fold_over_projections_of_vars_bound_by_closure ~closure_id_being_applied
~lhs_of_application ~bound_variables ~init:bindings_for_params_to_args
~f:(fun ~acc:body ~var ~expr -> Flambda.create_let var expr body)
in
(* Add bindings for variables corresponding to the functions introduced by
the whole set of closures. Each such variable will be bound to a closure;
each such closure is in turn produced by moving from the closure being
applied to another closure in the same set.
*)
let expr =
Variable.Set.fold (fun another_closure_in_the_same_set expr ->
let used =
Variable.Set.mem another_closure_in_the_same_set
function_body.free_variables
in
if used then
Flambda.create_let another_closure_in_the_same_set
(Move_within_set_of_closures {
closure = lhs_of_application;
start_from = closure_id_being_applied;
move_to = Closure_id.wrap another_closure_in_the_same_set;
})
expr
else expr)
fun_vars
bindings_for_vars_bound_by_closure_and_params_to_args
in
let env = E.set_never_inline env in
let env = E.activate_freshening env in
let env = E.set_inline_debuginfo ~dbg env in
simplify env r expr
type state = {
old_inside_to_new_inside : Variable.t Variable.Map.t;
(* Map from old inner vars to new inner vars *)
old_outside_to_new_outside : Variable.t Variable.Map.t;
(* Map from old outer vars to new outer vars *)
old_params_to_new_outside : Variable.t Variable.Map.t;
(* Map from old parameters to new outer vars. These are params
that should be specialised if they are copied to the new set of
closures. *)
old_fun_var_to_new_fun_var : Variable.t Variable.Map.t;
(* Map from old fun vars to new fun vars. These are the functions
that will be copied into the new set of closures *)
let_bindings : (Variable.t * Flambda.named) list;
(* Let bindings that will surround the definition of the new set
of closures *)
to_copy : Variable.t list;
(* List of functions that still need to be copied to the new set
of closures *)
new_funs : Flambda.function_declaration Variable.Map.t;
(* The function declarations for the new set of closures *)
new_free_vars_with_old_projections : Flambda.specialised_to Variable.Map.t;
(* The free variables for the new set of closures, but the projection
fields still point to old free variables. *)
new_specialised_args_with_old_projections :
Flambda.specialised_to Variable.Map.t;
(* The specialised parameters for the new set of closures, but the
projection fields still point to old specialised parameters. *)
}
let empty_state =
{ to_copy = [];
old_inside_to_new_inside = Variable.Map.empty;
old_outside_to_new_outside = Variable.Map.empty;
old_params_to_new_outside = Variable.Map.empty;
old_fun_var_to_new_fun_var = Variable.Map.empty;
let_bindings = [];
new_funs = Variable.Map.empty;
new_free_vars_with_old_projections = Variable.Map.empty;
new_specialised_args_with_old_projections = Variable.Map.empty; }
(* Add let bindings for the free vars in the set_of_closures and
add them to [old_outside_to_new_outside] *)
let bind_free_vars ~lhs_of_application ~closure_id_being_applied
~state ~free_vars =
Variable.Map.fold
(fun free_var (spec : Flambda.specialised_to) state ->
let var_clos = new_var Internal_variable_names.from_closure in
let expr : Flambda.named =
Project_var {
closure = lhs_of_application;
closure_id = closure_id_being_applied;
var = Var_within_closure.wrap free_var;
}
in
let let_bindings = (var_clos, expr) :: state.let_bindings in
let old_outside_to_new_outside =
Variable.Map.add spec.var var_clos state.old_outside_to_new_outside
in
{ state with let_bindings; old_outside_to_new_outside })
free_vars state
(* For arguments of specialised parameters:
- Add them to [old_outside_to_new_outside]
- Add them and their invariant aliases to [old_params_to_new_outside]
For other arguments that are also worth specialising:
- Add them and their invariant aliases to [old_params_to_new_outside] *)
let register_arguments ~specialised_args ~invariant_params
~state ~params ~args ~args_approxs =
let rec loop ~state ~params ~args ~args_approxs =
match params, args, args_approxs with
| [], [], [] -> state
| param :: params, arg :: args, arg_approx :: args_approxs -> begin
let param = Parameter.var param in
let worth_specialising, old_outside_to_new_outside =
match Variable.Map.find_opt param specialised_args with
| Some (spec : Flambda.specialised_to) ->
let old_outside_to_new_outside =
Variable.Map.add spec.var arg state.old_outside_to_new_outside
in
true, old_outside_to_new_outside
| None ->
let worth_specialising =
A.useful arg_approx
&& Variable.Map.mem param (Lazy.force invariant_params)
in
worth_specialising, state.old_outside_to_new_outside
in
let old_params_to_new_outside =
if worth_specialising then begin
let old_params_to_new_outside =
Variable.Map.add param arg state.old_params_to_new_outside
in
match Variable.Map.find_opt param (Lazy.force invariant_params) with
| Some set ->
Variable.Set.fold
(fun elem acc -> Variable.Map.add elem arg acc)
set old_params_to_new_outside
| None ->
old_params_to_new_outside
end else begin
state.old_params_to_new_outside
end
in
let state =
{ state with old_outside_to_new_outside; old_params_to_new_outside }
in
loop ~state ~params ~args ~args_approxs
end
| _, _, _ -> assert false
in
loop ~state ~params ~args ~args_approxs
(* Add an old parameter to [old_inside_to_new_inside]. If it appears in
[old_params_to_new_outside] then also add it to the new specialised args. *)
let add_param ~specialised_args ~state ~param =
let param = Parameter.var param in
let new_param = Variable.rename param in
let old_inside_to_new_inside =
Variable.Map.add param new_param state.old_inside_to_new_inside
in
let new_specialised_args_with_old_projections =
match Variable.Map.find_opt param specialised_args with
| Some (spec : Flambda.specialised_to) ->
let new_outside_var =
Variable.Map.find spec.var state.old_outside_to_new_outside
in
let new_spec : Flambda.specialised_to =
{ spec with var = new_outside_var }
in
Variable.Map.add new_param new_spec
state.new_specialised_args_with_old_projections
| None -> begin
match Variable.Map.find_opt param state.old_params_to_new_outside with
| None -> state.new_specialised_args_with_old_projections
| Some new_outside_var ->
let new_spec : Flambda.specialised_to =
{ var = new_outside_var; projection = None }
in
Variable.Map.add new_param new_spec
state.new_specialised_args_with_old_projections
end
in
let state =
{ state with old_inside_to_new_inside;
new_specialised_args_with_old_projections }
in
state, Parameter.wrap new_param
(* Add a let binding for an old fun_var, add it to the new free variables, and
add it to [old_inside_to_new_inside] *)
let add_fun_var ~lhs_of_application ~closure_id_being_applied ~state ~fun_var =
if Variable.Map.mem fun_var state.old_inside_to_new_inside then state
else begin
let inside_var = Variable.rename fun_var in
let outside_var = Variable.create Internal_variable_names.closure in
let expr =
Flambda.Move_within_set_of_closures
{ closure = lhs_of_application;
start_from = closure_id_being_applied;
move_to = Closure_id.wrap fun_var; }
in
let let_bindings = (outside_var, expr) :: state.let_bindings in
let spec : Flambda.specialised_to =
{ var = outside_var; projection = None; }
in
let new_free_vars_with_old_projections =
Variable.Map.add inside_var spec state.new_free_vars_with_old_projections
in
let old_inside_to_new_inside =
Variable.Map.add fun_var inside_var state.old_inside_to_new_inside
in
{ state with
old_inside_to_new_inside; let_bindings;
new_free_vars_with_old_projections }
end
(* Add an old free_var to the new free variables and add it to
[old_inside_to_new_inside]. *)
let add_free_var ~free_vars ~state ~free_var =
if Variable.Map.mem free_var state.old_inside_to_new_inside then state
else begin
let spec : Flambda.specialised_to = Variable.Map.find free_var free_vars in
let outside_var = spec.var in
let new_outside_var =
Variable.Map.find outside_var state.old_outside_to_new_outside
in
let new_spec : Flambda.specialised_to =
{ spec with var = new_outside_var }
in
let new_inside_var = Variable.rename free_var in
let new_free_vars_with_old_projections =
Variable.Map.add new_inside_var new_spec
state.new_free_vars_with_old_projections
in
let old_inside_to_new_inside =
Variable.Map.add free_var new_inside_var state.old_inside_to_new_inside
in
{ state with old_inside_to_new_inside; new_free_vars_with_old_projections }
end
(* Add a function to the new set of closures iff:
1) All it's specialised parameters are available in
[old_outside_to_new_outside]
2) At least one more parameter will become specialised *)
let add_function ~specialised_args ~state ~fun_var ~function_decl =
match function_decl.A.function_body with
| None -> None
| Some _ -> begin
let rec loop worth_specialising = function
| [] -> worth_specialising
| param :: params -> begin
let param = Parameter.var param in
match Variable.Map.find_opt param specialised_args with
| Some (spec : Flambda.specialised_to) ->
Variable.Map.mem spec.var state.old_outside_to_new_outside
&& loop worth_specialising params
| None ->
let worth_specialising =
worth_specialising
|| Variable.Map.mem param state.old_params_to_new_outside
in
loop worth_specialising params
end
in
let worth_specialising = loop false function_decl.A.params in
if not worth_specialising then None
else begin
let new_fun_var = Variable.rename fun_var in
let old_fun_var_to_new_fun_var =
Variable.Map.add fun_var new_fun_var state.old_fun_var_to_new_fun_var
in
let to_copy = fun_var :: state.to_copy in
let state = { state with old_fun_var_to_new_fun_var; to_copy } in
Some (state, new_fun_var)
end
end
(* Lookup a function in the new set of closures, trying to add it if
necessary. *)
let lookup_function ~specialised_args ~state ~fun_var ~function_decl =
match Variable.Map.find_opt fun_var state.old_fun_var_to_new_fun_var with
| Some new_fun_var -> Some (state, new_fun_var)
| None -> add_function ~specialised_args ~state ~fun_var ~function_decl
(* A direct call to a function in the new set of closures can be specialised
if all the function's newly specialised parameters are passed arguments
that are specialised to the same outside variable *)
let specialisable_call ~specialised_args ~state ~args ~params =
List.for_all2
(fun arg param ->
let param = Parameter.var param in
if Variable.Map.mem param specialised_args then true
else begin
let old_params_to_new_outside = state.old_params_to_new_outside in
match Variable.Map.find_opt param old_params_to_new_outside with
| None -> true
| Some outside_var -> begin
match Variable.Map.find_opt arg old_params_to_new_outside with
| Some outside_var' ->
Variable.equal outside_var outside_var'
| None -> false
end
end)
args params
(* Rewrite a call iff:
1) It is to a function in the old set of closures that can be specialised
2) All the newly specialised parameters of that function are passed values
known to be equal to their new specialisation. *)
let rec rewrite_direct_call ~specialised_args ~funs ~direct_call_surrogates
~state ~closure_id ~(apply : Flambda.apply) =
match Closure_id.Map.find_opt closure_id direct_call_surrogates with
| Some closure_id ->
rewrite_direct_call ~specialised_args ~funs ~direct_call_surrogates
~state ~closure_id ~apply
| None -> begin
let fun_var = Closure_id.unwrap closure_id in
match Variable.Map.find_opt fun_var funs with
| None -> None
| Some function_decl -> begin
match
lookup_function ~specialised_args ~state ~fun_var ~function_decl
with
| None -> None
| Some (state, new_fun_var) -> begin
let args = apply.args in
let params = function_decl.A.params in
let specialisable =
specialisable_call ~specialised_args ~state ~args ~params
in
if not specialisable then None
else begin
let kind = Flambda.Direct (Closure_id.wrap new_fun_var) in
let apply = { apply with func = new_fun_var; kind } in
Some (state, Flambda.Apply apply)
end
end
end
end
(* Rewrite the body a function declaration for use in the new set of
closures. *)
let rewrite_function ~lhs_of_application ~closure_id_being_applied
~direct_call_surrogates ~specialised_args ~free_vars ~funs
~state fun_var =
let function_decl : A.function_declaration =
Variable.Map.find fun_var funs
in
let function_body =
match function_decl.function_body with
| None -> assert false
| Some function_body -> function_body
in
let new_fun_var =
Variable.Map.find fun_var state.old_fun_var_to_new_fun_var
in
let state, params =
List.fold_right
(fun param (state, params) ->
let state, param = add_param ~specialised_args ~state ~param in
(state, param :: params))
function_decl.params (state, [])
in
let state =
Variable.Set.fold
(fun var state ->
if Variable.Map.mem var funs then
add_fun_var ~lhs_of_application ~closure_id_being_applied
~state ~fun_var:var
else if Variable.Map.mem var free_vars then
add_free_var ~free_vars ~state ~free_var:var
else
state)
function_body.free_variables state
in
let state_ref = ref state in
let body =
Flambda_iterators.map_toplevel_expr
(fun (expr : Flambda.t) ->
match expr with
| Apply ({ kind = Direct closure_id } as apply) -> begin
match
rewrite_direct_call ~specialised_args ~funs
~direct_call_surrogates ~state:!state_ref ~closure_id ~apply
with
| None -> expr
| Some (state, expr) ->
state_ref := state;
expr
end
| _ -> expr)
function_body.body
in
let body =
Flambda_utils.toplevel_substitution state.old_inside_to_new_inside body
in
let new_function_decl =
Flambda.create_function_declaration
~params ~body
~stub:function_body.stub
~dbg:function_body.dbg
~inline:function_body.inline
~specialise:function_body.specialise
~is_a_functor:function_body.is_a_functor
~closure_origin:(Closure_origin.create (Closure_id.wrap new_fun_var))
in
let new_funs =
Variable.Map.add new_fun_var new_function_decl state.new_funs
in
let state = { !state_ref with new_funs } in
state
let update_projections ~state projections =
let old_to_new = state.old_inside_to_new_inside in
Variable.Map.map
(fun (spec_to : Flambda.specialised_to) ->
let projection : Projection.t option =
match spec_to.projection with
| None -> None
| Some (Project_var proj) -> begin
match Variable.Map.find_opt proj.closure old_to_new with
| None -> None
| Some closure ->
let proj = { proj with closure } in
Some (Projection.Project_var proj)
end
| Some (Project_closure proj) -> begin
match Variable.Map.find_opt proj.set_of_closures old_to_new with
| None -> None
| Some set_of_closures ->
let proj = { proj with set_of_closures } in
Some (Projection.Project_closure proj)
end
| Some (Move_within_set_of_closures proj) -> begin
match Variable.Map.find_opt proj.closure old_to_new with
| None -> None
| Some closure ->
let proj = { proj with closure } in
Some (Projection.Move_within_set_of_closures proj)
end
| Some (Field (index, var)) -> begin
match Variable.Map.find_opt var old_to_new with
| None -> None
| Some var -> Some (Projection.Field(index, var))
end
in
{ spec_to with projection })
projections
let inline_by_copying_function_declaration
~(env : Inline_and_simplify_aux.Env.t)
~(r : Inline_and_simplify_aux.Result.t)
~(function_decls : A.function_declarations)
~(lhs_of_application : Variable.t)
~(inline_requested : Lambda.inline_attribute)
~(closure_id_being_applied : Closure_id.t)
~(function_decl : A.function_declaration)
~(args : Variable.t list)
~(args_approxs : A.t list)
~(invariant_params : Variable.Set.t Variable.Map.t lazy_t)
~(specialised_args : Flambda.specialised_to Variable.Map.t)
~(free_vars : Flambda.specialised_to Variable.Map.t)
~(direct_call_surrogates : Closure_id.t Closure_id.Map.t)
~(dbg : Debuginfo.t)
~(simplify : Inlining_decision_intf.simplify) =
let state = empty_state in
let state =
bind_free_vars ~lhs_of_application ~closure_id_being_applied
~state ~free_vars
in
let params = function_decl.params in
let state =
register_arguments ~specialised_args ~invariant_params
~state ~params ~args ~args_approxs
in
let fun_var = Closure_id.unwrap closure_id_being_applied in
match add_function ~specialised_args ~state ~fun_var ~function_decl with
| None -> None
| Some (state, new_fun_var) -> begin
let funs = function_decls.funs in
let rec loop state =
match state.to_copy with
| [] -> state
| next :: rest ->
let state = { state with to_copy = rest } in
let state =
rewrite_function ~lhs_of_application ~closure_id_being_applied
~direct_call_surrogates ~specialised_args ~free_vars ~funs
~state next
in
loop state
in
let state = loop state in
let closure_id = Closure_id.wrap new_fun_var in
let function_decls =
Flambda.create_function_declarations_with_origin
~funs:state.new_funs
~set_of_closures_origin:function_decls.set_of_closures_origin
~is_classic_mode:function_decls.is_classic_mode
in
let free_vars =
update_projections ~state
state.new_free_vars_with_old_projections
in
let specialised_args =
update_projections ~state
state.new_specialised_args_with_old_projections
in
let direct_call_surrogates = Variable.Map.empty in
let set_of_closures =
Flambda.create_set_of_closures ~function_decls
~free_vars ~specialised_args ~direct_call_surrogates
in
let closure_var = new_var Internal_variable_names.dup_func in
let set_of_closures_var =
new_var Internal_variable_names.dup_set_of_closures
in
let project : Flambda.project_closure =
{set_of_closures = set_of_closures_var; closure_id}
in
let apply : Flambda.apply =
{ func = closure_var; args; kind = Direct closure_id; dbg;
inline = inline_requested; specialise = Default_specialise; }
in
let body =
Flambda.create_let
set_of_closures_var (Set_of_closures set_of_closures)
(Flambda.create_let closure_var (Project_closure project)
(Apply apply))
in
let expr = Flambda_utils.bind ~body ~bindings:state.let_bindings in
let env = E.activate_freshening (E.set_never_inline env) in
Some (simplify env r expr)
end
|