Skip to content

Commit dc01094

Browse files
brianrourkebollbrianrourkeboll
authored
Reenable β-reduction of immediately-invoked F#-defined generic delegates (#18401)
1 parent 1595946 commit dc01094

14 files changed

+1487
-16
lines changed

Diff for: ‎docs/release-notes/.FSharp.Compiler.Service/9.0.300.md

+1
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@
2020
* Fix duplicate parse error reporting for GetBackgroundCheckResultsForFileInProject ([Issue #18379](https://github.com/dotnet/fsharp/issues/18379) [PR #18380](https://github.com/dotnet/fsharp/pull/18380))
2121
* Fix MethodDefNotFound when compiling code invoking delegate with option parameter ([Issue #5171](https://github.com/dotnet/fsharp/issues/5171), [PR #18385](https://github.com/dotnet/fsharp/pull/18385))
2222
* Fix #r nuget ..." downloads unneeded packages ([Issue #18231](https://github.com/dotnet/fsharp/issues/18231), [PR #18393](https://github.com/dotnet/fsharp/pull/18393))
23+
* Reenable β-reduction and subsequent reoptimization of immediately-invoked F#-defined generic delegates. ([PR #18401](https://github.com/dotnet/fsharp/pull/18401))
2324

2425
### Added
2526
* Added missing type constraints in FCS. ([PR #18241](https://github.com/dotnet/fsharp/pull/18241))

Diff for: ‎src/Compiler/Optimize/Optimizer.fs

+7-7
Original file line numberDiff line numberDiff line change
@@ -1734,9 +1734,9 @@ let TryEliminateBinding cenv _env bind e2 _m =
17341734

17351735
// Immediate consumption of delegate via an application in a sequential, e.g. 'let part1 = e in part1.Invoke(args); rest'
17361736
// See https://github.com/fsharp/fslang-design/blob/master/tooling/FST-1034-lambda-optimizations.md
1737-
| Expr.Sequential(DebugPoints(DelegateInvokeExpr g (delInvokeRef, delInvokeTy, DebugPoints (Expr.Val (VRefLocal vspec2, _, _), recreate2), delInvokeArg, _), recreate1), rest, NormalSeq, m)
1737+
| Expr.Sequential(DebugPoints(DelegateInvokeExpr g (delInvokeRef, delInvokeTy, tyargs, DebugPoints (Expr.Val (VRefLocal vspec2, _, _), recreate2), delInvokeArg, _), recreate1), rest, NormalSeq, m)
17381738
when IsUniqueUse vspec2 [rest;delInvokeArg] ->
1739-
let invoke = MakeFSharpDelegateInvokeAndTryBetaReduce g (delInvokeRef, recreate2 e1, delInvokeTy, delInvokeArg, m)
1739+
let invoke = MakeFSharpDelegateInvokeAndTryBetaReduce g (delInvokeRef, recreate2 e1, delInvokeTy, tyargs, delInvokeArg, m)
17401740
Some (Expr.Sequential(recreate1 invoke, rest, NormalSeq, m) |> recreate0)
17411741

17421742
// Immediate consumption of value by a pattern match 'let x = e in match x with ...'
@@ -2397,8 +2397,8 @@ let rec OptimizeExpr cenv (env: IncrementalOptimizationEnv) expr =
23972397

23982398
| Expr.App (f, fty, tyargs, argsl, m) ->
23992399
match expr with
2400-
| DelegateInvokeExpr g (delInvokeRef, delInvokeTy, delExpr, delInvokeArg, m) ->
2401-
OptimizeFSharpDelegateInvoke cenv env (delInvokeRef, delExpr, delInvokeTy, delInvokeArg, m)
2400+
| DelegateInvokeExpr g (delInvokeRef, delInvokeTy, tyargs, delExpr, delInvokeArg, m) ->
2401+
OptimizeFSharpDelegateInvoke cenv env (delInvokeRef, delExpr, delInvokeTy, tyargs, delInvokeArg, m)
24022402
| _ ->
24032403
let attempt =
24042404
if IsDebugPipeRightExpr cenv expr then
@@ -3799,18 +3799,18 @@ and OptimizeDebugPipeRights cenv env expr =
37993799
pipesExprR
38003800
expr, { pipesInfo with HasEffect=true}
38013801

3802-
and OptimizeFSharpDelegateInvoke cenv env (delInvokeRef, delExpr, delInvokeTy, delInvokeArg, m) =
3802+
and OptimizeFSharpDelegateInvoke cenv env (delInvokeRef, delExpr, delInvokeTy, tyargs, delInvokeArg, m) =
38033803
let g = cenv.g
38043804
let optf0, finfo = OptimizeExpr cenv env delExpr
38053805

3806-
match StripPreComputationsFromComputedFunction g optf0 [delInvokeArg] (fun f delInvokeArgsR -> MakeFSharpDelegateInvokeAndTryBetaReduce g (delInvokeRef, f, delInvokeTy, List.head delInvokeArgsR, m)) with
3806+
match StripPreComputationsFromComputedFunction g optf0 [delInvokeArg] (fun f delInvokeArgsR -> MakeFSharpDelegateInvokeAndTryBetaReduce g (delInvokeRef, f, delInvokeTy, tyargs, List.head delInvokeArgsR, m)) with
38073807
| Choice1Of2 remade ->
38083808
OptimizeExpr cenv env remade
38093809
| Choice2Of2 (newf0, remake) ->
38103810

38113811
let newDelInvokeArgs, arginfos = OptimizeExprsThenConsiderSplits cenv env [delInvokeArg]
38123812
let newDelInvokeArg = List.head newDelInvokeArgs
3813-
let reducedExpr = MakeFSharpDelegateInvokeAndTryBetaReduce g (delInvokeRef, newf0, delInvokeTy, newDelInvokeArg, m)
3813+
let reducedExpr = MakeFSharpDelegateInvokeAndTryBetaReduce g (delInvokeRef, newf0, delInvokeTy, tyargs, newDelInvokeArg, m)
38143814
let newExpr = reducedExpr |> remake
38153815
match newf0, reducedExpr with
38163816
| Expr.Obj _, Expr.Let _ ->

Diff for: ‎src/Compiler/TypedTree/TypedTreeOps.fs

+6-6
Original file line numberDiff line numberDiff line change
@@ -8465,9 +8465,9 @@ let (|NewDelegateExpr|_|) g expr =
84658465
[<return: Struct>]
84668466
let (|DelegateInvokeExpr|_|) g expr =
84678467
match expr with
8468-
| Expr.App ((Expr.Val (invokeRef, _, _)) as delInvokeRef, delInvokeTy, [], [delExpr;delInvokeArg], m)
8468+
| Expr.App ((Expr.Val (invokeRef, _, _)) as delInvokeRef, delInvokeTy, tyargs, [delExpr;delInvokeArg], m)
84698469
when invokeRef.LogicalName = "Invoke" && isFSharpDelegateTy g (tyOfExpr g delExpr) ->
8470-
ValueSome(delInvokeRef, delInvokeTy, delExpr, delInvokeArg, m)
8470+
ValueSome(delInvokeRef, delInvokeTy, tyargs, delExpr, delInvokeArg, m)
84718471
| _ -> ValueNone
84728472

84738473
[<return: Struct>]
@@ -8494,17 +8494,17 @@ let (|OpPipeRight3|_|) g expr =
84948494
ValueSome(resType, arg1, arg2, arg3, fExpr, m)
84958495
| _ -> ValueNone
84968496

8497-
let rec MakeFSharpDelegateInvokeAndTryBetaReduce g (delInvokeRef, delExpr, delInvokeTy, delInvokeArg, m) =
8497+
let rec MakeFSharpDelegateInvokeAndTryBetaReduce g (delInvokeRef, delExpr, delInvokeTy, tyargs, delInvokeArg, m) =
84988498
match delExpr with
84998499
| Expr.Let (bind, body, mLet, _) ->
8500-
mkLetBind mLet bind (MakeFSharpDelegateInvokeAndTryBetaReduce g (delInvokeRef, body, delInvokeTy, delInvokeArg, m))
8501-
| NewDelegateExpr g (_, argvs, body, m, _) when argvs.Length > 0 ->
8500+
mkLetBind mLet bind (MakeFSharpDelegateInvokeAndTryBetaReduce g (delInvokeRef, body, delInvokeTy, tyargs, delInvokeArg, m))
8501+
| NewDelegateExpr g (_, argvs & _ :: _, body, m, _) ->
85028502
let pairs, body = MultiLambdaToTupledLambdaIfNeeded g (argvs, delInvokeArg) body
85038503
let argvs2, args2 = List.unzip pairs
85048504
mkLetsBind m (mkCompGenBinds argvs2 args2) body
85058505
| _ ->
85068506
// Remake the delegate invoke
8507-
Expr.App (delInvokeRef, delInvokeTy, [], [delExpr; delInvokeArg], m)
8507+
Expr.App (delInvokeRef, delInvokeTy, tyargs, [delExpr; delInvokeArg], m)
85088508

85098509
//---------------------------------------------------------------------------
85108510
// Adjust for expected usage

Diff for: ‎src/Compiler/TypedTree/TypedTreeOps.fsi

+4-2
Original file line numberDiff line numberDiff line change
@@ -1438,7 +1438,9 @@ val MakeApplicationAndBetaReduce: TcGlobals -> Expr * TType * TypeInst list * Ex
14381438
/// Make a delegate invoke expression for an F# delegate type, doing beta reduction by introducing let-bindings
14391439
/// if the delegate expression is a construction of a delegate.
14401440
val MakeFSharpDelegateInvokeAndTryBetaReduce:
1441-
TcGlobals -> delInvokeRef: Expr * delExpr: Expr * delInvokeTy: TType * delInvokeArg: Expr * m: range -> Expr
1441+
TcGlobals ->
1442+
delInvokeRef: Expr * delExpr: Expr * delInvokeTy: TType * tyargs: TypeInst * delInvokeArg: Expr * m: range ->
1443+
Expr
14421444

14431445
/// Combine two static-resolution requirements on a type parameter
14441446
val JoinTyparStaticReq: TyparStaticReq -> TyparStaticReq -> TyparStaticReq
@@ -2751,7 +2753,7 @@ val (|NewDelegateExpr|_|): TcGlobals -> Expr -> (Unique * Val list * Expr * rang
27512753

27522754
/// Match a .Invoke on a delegate
27532755
[<return: Struct>]
2754-
val (|DelegateInvokeExpr|_|): TcGlobals -> Expr -> (Expr * TType * Expr * Expr * range) voption
2756+
val (|DelegateInvokeExpr|_|): TcGlobals -> Expr -> (Expr * TType * TypeInst * Expr * Expr * range) voption
27552757

27562758
/// Match 'if __useResumableCode then ... else ...' expressions
27572759
[<return: Struct>]

Diff for: ‎tests/FSharp.Compiler.ComponentTests/EmittedIL/ComputationExpressions/ComputationExpressions.fs

+13
Original file line numberDiff line numberDiff line change
@@ -73,3 +73,16 @@ module ComputationExpressions =
7373
compilation
7474
|> getCompilation
7575
|> verifyCompilation
76+
77+
[<Theory; FileInlineData("CustomCollectionBuilderComputationExpr.fs", Optimize=BooleanOptions.Both)>]
78+
let ``CustomCollectionBuilderComputationExpr_fs_OptimizeOff`` compilation =
79+
compilation
80+
|> getCompilation
81+
|> asExe
82+
|> withReferences [
83+
FsFromPath (Path.Combine (__SOURCE_DIRECTORY__, "CustomCollectionBuilderComputationExprLibrary.fs"))
84+
|> withName "CustomCollectionBuilderComputationExprLibrary"
85+
]
86+
|> withEmbeddedPdb
87+
|> withEmbedAllSource
88+
|> verifyILBaseline

Diff for: ‎tests/FSharp.Compiler.ComponentTests/EmittedIL/ComputationExpressions/CustomCollectionBuilderComputationExpr.fs

+14
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,14 @@
1+
module ComputationExpressions.Program
2+
3+
let f0 () =
4+
let xs = ResizeArray ()
5+
xs.Add 1
6+
xs.Add 2
7+
xs.Add 3
8+
xs
9+
10+
let xs = f0 ()
11+
12+
let f1 () = resizeArray { 1; 2; 3 }
13+
let f2 () = resizeArray { yield! xs }
14+
let f3 () = resizeArray { for x in xs -> x * x }

Diff for: ‎tests/FSharp.Compiler.ComponentTests/EmittedIL/ComputationExpressions/CustomCollectionBuilderComputationExpr.fs.Optimize.il.bsl

+228
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,228 @@
1+
2+
3+
4+
5+
6+
.assembly extern runtime { }
7+
.assembly extern FSharp.Core { }
8+
.assembly extern assemblyLibrary
9+
{
10+
.ver 0:0:0:0
11+
}
12+
.assembly assembly
13+
{
14+
.custom instance void [FSharp.Core]Microsoft.FSharp.Core.FSharpInterfaceDataVersionAttribute::.ctor(int32,
15+
int32,
16+
int32) = ( 01 00 02 00 00 00 00 00 00 00 00 00 00 00 00 00 )
17+
18+
19+
20+
21+
.hash algorithm 0x00008004
22+
.ver 0:0:0:0
23+
}
24+
.module assembly.exe
25+
26+
.imagebase {value}
27+
.file alignment 0x00000200
28+
.stackreserve 0x00100000
29+
.subsystem 0x0003
30+
.corflags 0x00000001
31+
32+
33+
34+
35+
36+
.class public abstract auto ansi sealed ComputationExpressions.Program
37+
extends [runtime]System.Object
38+
{
39+
.custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 )
40+
.field static assembly class [runtime]System.Collections.Generic.List`1<int32> xs@10
41+
.custom instance void [runtime]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [runtime]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 )
42+
.method public static class [runtime]System.Collections.Generic.List`1<int32> f0() cil managed
43+
{
44+
45+
.maxstack 4
46+
.locals init (class [runtime]System.Collections.Generic.List`1<int32> V_0)
47+
IL_0000: newobj instance void class [runtime]System.Collections.Generic.List`1<int32>::.ctor()
48+
IL_0005: stloc.0
49+
IL_0006: ldloc.0
50+
IL_0007: ldc.i4.1
51+
IL_0008: callvirt instance void class [runtime]System.Collections.Generic.List`1<int32>::Add(!0)
52+
IL_000d: ldloc.0
53+
IL_000e: ldc.i4.2
54+
IL_000f: callvirt instance void class [runtime]System.Collections.Generic.List`1<int32>::Add(!0)
55+
IL_0014: ldloc.0
56+
IL_0015: ldc.i4.3
57+
IL_0016: callvirt instance void class [runtime]System.Collections.Generic.List`1<int32>::Add(!0)
58+
IL_001b: ldloc.0
59+
IL_001c: ret
60+
}
61+
62+
.method public specialname static class [runtime]System.Collections.Generic.List`1<int32> get_xs() cil managed
63+
{
64+
65+
.maxstack 8
66+
IL_0000: ldsfld class [runtime]System.Collections.Generic.List`1<int32> ComputationExpressions.Program::xs@10
67+
IL_0005: ret
68+
}
69+
70+
.method public static class [runtime]System.Collections.Generic.List`1<int32> f1() cil managed
71+
{
72+
73+
.maxstack 4
74+
.locals init (class [assemblyLibrary]ComputationExpressions.Library/ResizeArrayBuilder`1<int32> V_0,
75+
class [runtime]System.Collections.Generic.List`1<int32> V_1,
76+
class [runtime]System.Collections.Generic.List`1<int32>& V_2)
77+
IL_0000: call class [assemblyLibrary]ComputationExpressions.Library/ResizeArrayBuilder`1<!0> class [assemblyLibrary]ComputationExpressions.Library/ResizeArrayBuilder`1<int32>::get_Instance()
78+
IL_0005: stloc.0
79+
IL_0006: newobj instance void class [runtime]System.Collections.Generic.List`1<int32>::.ctor()
80+
IL_000b: stloc.1
81+
IL_000c: ldloca.s V_1
82+
IL_000e: stloc.2
83+
IL_000f: ldloc.2
84+
IL_0010: ldobj class [runtime]System.Collections.Generic.List`1<int32>
85+
IL_0015: ldc.i4.1
86+
IL_0016: callvirt instance void class [runtime]System.Collections.Generic.List`1<int32>::Add(!0)
87+
IL_001b: ldloca.s V_1
88+
IL_001d: stloc.2
89+
IL_001e: ldloc.2
90+
IL_001f: ldobj class [runtime]System.Collections.Generic.List`1<int32>
91+
IL_0024: ldc.i4.2
92+
IL_0025: callvirt instance void class [runtime]System.Collections.Generic.List`1<int32>::Add(!0)
93+
IL_002a: ldloca.s V_1
94+
IL_002c: stloc.2
95+
IL_002d: ldloc.2
96+
IL_002e: ldobj class [runtime]System.Collections.Generic.List`1<int32>
97+
IL_0033: ldc.i4.3
98+
IL_0034: callvirt instance void class [runtime]System.Collections.Generic.List`1<int32>::Add(!0)
99+
IL_0039: ldloc.1
100+
IL_003a: ret
101+
}
102+
103+
.method public static class [runtime]System.Collections.Generic.List`1<int32> f2() cil managed
104+
{
105+
106+
.maxstack 4
107+
.locals init (class [assemblyLibrary]ComputationExpressions.Library/ResizeArrayBuilder`1<int32> V_0,
108+
class [runtime]System.Collections.Generic.List`1<int32> V_1,
109+
class [runtime]System.Collections.Generic.List`1<int32>& V_2)
110+
IL_0000: call class [assemblyLibrary]ComputationExpressions.Library/ResizeArrayBuilder`1<!0> class [assemblyLibrary]ComputationExpressions.Library/ResizeArrayBuilder`1<int32>::get_Instance()
111+
IL_0005: stloc.0
112+
IL_0006: newobj instance void class [runtime]System.Collections.Generic.List`1<int32>::.ctor()
113+
IL_000b: stloc.1
114+
IL_000c: ldloca.s V_1
115+
IL_000e: stloc.2
116+
IL_000f: ldloc.2
117+
IL_0010: ldobj class [runtime]System.Collections.Generic.List`1<int32>
118+
IL_0015: call class [runtime]System.Collections.Generic.List`1<int32> ComputationExpressions.Program::get_xs()
119+
IL_001a: callvirt instance void class [runtime]System.Collections.Generic.List`1<int32>::AddRange(class [runtime]System.Collections.Generic.IEnumerable`1<!0>)
120+
IL_001f: ldloc.1
121+
IL_0020: ret
122+
}
123+
124+
.method public static class [runtime]System.Collections.Generic.List`1<int32> f3() cil managed
125+
{
126+
127+
.maxstack 5
128+
.locals init (class [assemblyLibrary]ComputationExpressions.Library/ResizeArrayBuilder`1<int32> V_0,
129+
class [runtime]System.Collections.Generic.List`1<int32> V_1,
130+
int32 V_2,
131+
int32 V_3,
132+
int32 V_4,
133+
int32 V_5,
134+
class [runtime]System.Collections.Generic.List`1<int32>& V_6)
135+
IL_0000: call class [assemblyLibrary]ComputationExpressions.Library/ResizeArrayBuilder`1<!0> class [assemblyLibrary]ComputationExpressions.Library/ResizeArrayBuilder`1<int32>::get_Instance()
136+
IL_0005: stloc.0
137+
IL_0006: newobj instance void class [runtime]System.Collections.Generic.List`1<int32>::.ctor()
138+
IL_000b: stloc.1
139+
IL_000c: ldc.i4.0
140+
IL_000d: stloc.3
141+
IL_000e: call class [runtime]System.Collections.Generic.List`1<int32> ComputationExpressions.Program::get_xs()
142+
IL_0013: callvirt instance int32 class [runtime]System.Collections.Generic.List`1<int32>::get_Count()
143+
IL_0018: ldc.i4.1
144+
IL_0019: sub
145+
IL_001a: stloc.2
146+
IL_001b: ldloc.2
147+
IL_001c: ldloc.3
148+
IL_001d: blt.s IL_004f
149+
150+
IL_001f: call class [runtime]System.Collections.Generic.List`1<int32> ComputationExpressions.Program::get_xs()
151+
IL_0024: ldloc.3
152+
IL_0025: callvirt instance !0 class [runtime]System.Collections.Generic.List`1<int32>::get_Item(int32)
153+
IL_002a: stloc.s V_4
154+
IL_002c: ldloc.s V_4
155+
IL_002e: ldloc.s V_4
156+
IL_0030: mul
157+
IL_0031: stloc.s V_5
158+
IL_0033: ldloca.s V_1
159+
IL_0035: stloc.s V_6
160+
IL_0037: ldloc.s V_6
161+
IL_0039: ldobj class [runtime]System.Collections.Generic.List`1<int32>
162+
IL_003e: ldloc.s V_5
163+
IL_0040: callvirt instance void class [runtime]System.Collections.Generic.List`1<int32>::Add(!0)
164+
IL_0045: ldloc.3
165+
IL_0046: ldc.i4.1
166+
IL_0047: add
167+
IL_0048: stloc.3
168+
IL_0049: ldloc.3
169+
IL_004a: ldloc.2
170+
IL_004b: ldc.i4.1
171+
IL_004c: add
172+
IL_004d: bne.un.s IL_001f
173+
174+
IL_004f: ldloc.1
175+
IL_0050: ret
176+
}
177+
178+
.method private specialname rtspecialname static void .cctor() cil managed
179+
{
180+
181+
.maxstack 8
182+
IL_0000: ldc.i4.0
183+
IL_0001: stsfld int32 '<StartupCode$assembly>.$ComputationExpressions'.Program::init@
184+
IL_0006: ldsfld int32 '<StartupCode$assembly>.$ComputationExpressions'.Program::init@
185+
IL_000b: pop
186+
IL_000c: ret
187+
}
188+
189+
.method assembly specialname static void staticInitialization@() cil managed
190+
{
191+
192+
.maxstack 8
193+
IL_0000: call class [runtime]System.Collections.Generic.List`1<int32> ComputationExpressions.Program::f0()
194+
IL_0005: stsfld class [runtime]System.Collections.Generic.List`1<int32> ComputationExpressions.Program::xs@10
195+
IL_000a: ret
196+
}
197+
198+
.property class [runtime]System.Collections.Generic.List`1<int32>
199+
xs()
200+
{
201+
.custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 09 00 00 00 00 00 )
202+
.get class [runtime]System.Collections.Generic.List`1<int32> ComputationExpressions.Program::get_xs()
203+
}
204+
}
205+
206+
.class private abstract auto ansi sealed '<StartupCode$assembly>.$ComputationExpressions'.Program
207+
extends [runtime]System.Object
208+
{
209+
.field static assembly int32 init@
210+
.custom instance void [runtime]System.Diagnostics.DebuggerBrowsableAttribute::.ctor(valuetype [runtime]System.Diagnostics.DebuggerBrowsableState) = ( 01 00 00 00 00 00 00 00 )
211+
.custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 )
212+
.custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 )
213+
.method public static void main@() cil managed
214+
{
215+
.entrypoint
216+
217+
.maxstack 8
218+
IL_0000: call void ComputationExpressions.Program::staticInitialization@()
219+
IL_0005: ret
220+
}
221+
222+
}
223+
224+
225+
226+
227+
228+

0 commit comments

Comments
 (0)