Implement direct delegates

docs/release-notes/.FSharp.Compiler.Service/11.0.100.md

@@ -130,6 +130,7 @@
 ### Improved
 
 * Nullness warning FS3261 on dotted method or property access (e.g. `x.Member`) now underlines the receiver expression and includes the member name and (when known) the binding name in the message. ([Issue #19658](https://github.com/dotnet/fsharp/issues/19658), [PR #19814](https://github.com/dotnet/fsharp/pull/19814))
+* Direct delegate construction ([PR ##19993](https://github.com/dotnet/fsharp/pull/19993))
 
 ### Changed
 

docs/release-notes/.Language/preview.md

@@ -8,4 +8,6 @@
 
 ### Fixed
 
-### Changed
+### Changed
+
+* Direct delegate construction ([PR ##19993](https://github.com/dotnet/fsharp/pull/19993))

src/Compiler/FSComp.txt

@@ -1824,5 +1824,6 @@ featurePreprocessorElif,"#elif preprocessor directive"
 3890,tcRecursiveInlineNotAllowed,"The value or member '%s' has been marked 'inline' but is part of a recursive binding group. F# does not support recursive 'inline' values. Either remove the 'inline' modifier or refactor the recursion."
 featureExceptionFieldSerializationSupport,"emit GetObjectData and field-restoring deserialization constructor for exception types"
 featureErrorOnMissingSignatureAttribute,"error (rather than warning) when an enforced compiler-semantic attribute is present in the .fs but missing from the .fsi"
+featureDirectDelegateConstruction,"construct delegates that point directly at the target method, avoiding an intermediate closure"
 featureAccessProtectedBaseFieldFromClosure,"Access a protected base-class field from a closure inside a member"
 featureImprovedImpliedArgumentNamesPartTwo,"Improved implied argument names with partial application"

src/Compiler/FSharp.Compiler.Service.fsproj

@@ -418,6 +418,7 @@
     <Compile Include="Checking\CheckDeclarations.fs" />
     <Compile Include="Checking\SignatureHash.fsi" />
     <Compile Include="Checking\SignatureHash.fs" />
+    <Compile Include="Optimize\DelegateForwarding.fs" />
     <Compile Include="Optimize\Optimizer.fsi" />
     <Compile Include="Optimize\Optimizer.fs" />
     <Compile Include="Optimize\DetupleArgs.fsi" />

src/Compiler/Facilities/LanguageFeatures.fs

@@ -110,6 +110,7 @@ type LanguageFeature =
     | PreprocessorElif
     | ExceptionFieldSerializationSupport
     | ErrorOnMissingSignatureAttribute
+    | DirectDelegateConstruction
     | AccessProtectedBaseFieldFromClosure
     | ImprovedImpliedArgumentNamesPartTwo
 
@@ -266,6 +267,7 @@ type LanguageVersion(versionText, ?disabledFeaturesArray: LanguageFeature array)
                 LanguageFeature.MethodOverloadsCache, previewVersion // Performance optimization for overload resolution
                 LanguageFeature.ImplicitDIMCoverage, languageVersion110
                 LanguageFeature.ErrorOnMissingSignatureAttribute, previewVersion // Opt-in: turn FS3888 from warning into error
+                LanguageFeature.DirectDelegateConstruction, previewVersion
                 LanguageFeature.AccessProtectedBaseFieldFromClosure, previewVersion // #5302: read a protected base field from a closure
             ]
 
@@ -463,6 +465,7 @@ type LanguageVersion(versionText, ?disabledFeaturesArray: LanguageFeature array)
         | LanguageFeature.PreprocessorElif -> FSComp.SR.featurePreprocessorElif ()
         | LanguageFeature.ExceptionFieldSerializationSupport -> FSComp.SR.featureExceptionFieldSerializationSupport ()
         | LanguageFeature.ErrorOnMissingSignatureAttribute -> FSComp.SR.featureErrorOnMissingSignatureAttribute ()
+        | LanguageFeature.DirectDelegateConstruction -> FSComp.SR.featureDirectDelegateConstruction ()
         | LanguageFeature.AccessProtectedBaseFieldFromClosure -> FSComp.SR.featureAccessProtectedBaseFieldFromClosure ()
         | LanguageFeature.ImprovedImpliedArgumentNamesPartTwo -> FSComp.SR.featureImprovedImpliedArgumentNamesPartTwo ()
 

src/Compiler/Facilities/LanguageFeatures.fsi

@@ -101,6 +101,7 @@ type LanguageFeature =
     | PreprocessorElif
     | ExceptionFieldSerializationSupport
     | ErrorOnMissingSignatureAttribute
+    | DirectDelegateConstruction
     | AccessProtectedBaseFieldFromClosure
     | ImprovedImpliedArgumentNamesPartTwo
 

src/Compiler/Optimize/Optimizer.fs

@@ -12,6 +12,7 @@ open FSharp.Compiler
 open FSharp.Compiler.AbstractIL.IL
 open FSharp.Compiler.AttributeChecking
 open FSharp.Compiler.CompilerGlobalState
+open FSharp.Compiler.DelegateForwarding
 open FSharp.Compiler.DiagnosticsLogger
 open FSharp.Compiler.Text.Range
 open FSharp.Compiler.Syntax.PrettyNaming
@@ -1707,7 +1708,7 @@ and OpHasEffect context g m op tyargs =
     | TOp.ExnFieldSet _
     | TOp.Coerce
     | TOp.Reraise
-    | TOp.IntegerForLoop _ 
+    | TOp.IntegerForLoop _
     | TOp.While _
     | TOp.TryWith _ (* conservative *)
     | TOp.TryFinally _ (* conservative *)
@@ -1722,6 +1723,43 @@ and OpHasEffect context g m op tyargs =
 let effectContextOf (cenv: cenv) =
     if cenv.optimizing then EffectContext.Emit else EffectContext.InlineBody
 
+/// When a delegate construction's Invoke body is a transparent forwarding call that the ILX generator can
+/// point the delegate directly at (see DelegateForwarding), prevent the optimizer from inlining the target
+/// into the body: inlining would dissolve the forwarding call before code generation and force the delegate
+/// back into a closure, making the emitted form depend on the target's size. Only optimizer-chosen inlining
+/// is suppressed. Cross-assembly inlining of a target from a referenced assembly's optimization
+/// data goes through this same inlining path, so it is suppressed here as well.
+let AddDirectDelegateTargetToDontInlineSet cenv env (slotsig: SlotSig) tmvs body m =
+    let g = cenv.g
+
+    if
+        g.langVersion.SupportsFeature Features.LanguageFeature.DirectDelegateConstruction
+        && cenv.optimizing
+        && cenv.settings.InlineLambdas
+    then
+        // Normalize the Invoke parameters exactly as IlxGen will before it runs the recognizer.
+        let invokeParamInfos =
+            List.replicate (List.concat slotsig.FormalParams).Length ValReprInfo.unnamedTopArg1
+
+        let tmvs, body = BindUnitVars g (tmvs, invokeParamInfos, body)
+
+        match classifyForwardingTarget (ExprHasEffect (effectContextOf cenv)) g tmvs body with
+        | DirectDelegateForwardingTargetCandidate.FSharpVal(vref, valUseFlags, _, leadingArgs) when
+            // Only a value compiled as a real method can be pointed at directly (mirrors IlxGen's
+            // Method-storage requirement); local function values keep their inlining. Witness information
+            // is not computable here, so 'false' is passed - over-suppressing for the rare
+            // witness-requiring target only costs a missed inline in a body that stays a closure.
+            vref.ValReprInfo.IsSome
+            && (fsharpValDirectlyBindable (ExprHasEffect (effectContextOf cenv)) g tmvs leadingArgs vref valUseFlags false)
+                .IsSome
+            ->
+            match (GetInfoForVal cenv env m vref).ValExprInfo with
+            | StripLambdaValue(lambdaId, _, _, _, _) ->
+                { env with dontInline = Map.add lambdaId [] env.dontInline }
+            | _ -> env
+        | _ -> env
+    else
+        env
 
 let TryEliminateBinding cenv _env bind e2 _m =
     let g = cenv.g
@@ -2441,11 +2479,16 @@ let rec OptimizeExpr cenv (env: IncrementalOptimizationEnv) expr =
             MightMakeCriticalTailcall=false
             Info=UnknownValue }
 
-    | Expr.Obj (_, ty, basev, createExpr, overrides, iimpls, m) -> 
-        match expr with 
-        | NewDelegateExpr g (lambdaId, vsl, body, _, remake) -> 
+    | Expr.Obj (_, ty, basev, createExpr, overrides, iimpls, m) ->
+        match expr with
+        | NewDelegateExpr g (lambdaId, vsl, body, _, remake) ->
+            let env =
+                match overrides with
+                | [ TObjExprMethod(slotsig, _, _, _, _, mMeth) ] ->
+                    AddDirectDelegateTargetToDontInlineSet cenv env slotsig vsl body mMeth
+                | _ -> env
             OptimizeNewDelegateExpr cenv env (lambdaId, vsl, body, remake)
-        | _ -> 
+        | _ ->
             OptimizeObjectExpr cenv env (ty, basev, createExpr, overrides, iimpls, m)
 
     | Expr.Op (op, tyargs, args, m) -> 

tests/FSharp.Compiler.ComponentTests/EmittedIL/DirectDelegates/DelegateCustomType.fs

@@ -0,0 +1,42 @@
+module DelegateCustomType
+
+open System
+
+// Custom, F#-declared delegate types exercise construction with delegates defined in the *compiled* assembly
+// (local scope, unlike imported BCL Func/Action) and with Invoke signatures the Func/Action tests do not
+// cover: a multi-argument (tupled) signature, a generic delegate, and a byref parameter. (F# forbids curried
+// delegate signatures — FS0950 — so every F# delegate has a single tupled Invoke parameter group.)
+
+type DTupled = delegate of int * int -> int
+type DGen<'T> = delegate of 'T -> 'T
+type DByref = delegate of byref<int> -> unit
+
+let acc (x: int) (y: int) : int = x + y
+
+let ident (x: 'T) : 'T = x
+
+type C() =
+    member _.M (x: int) (y: int) : int = x * y
+
+// Tupled-signature custom delegate: Invoke(int, int).
+// 28. non-eta module function, custom delegate
+let tupledNonEta () = DTupled(acc)
+// 14. eta module function, custom delegate
+let tupledEta () = DTupled(fun a b -> acc a b)
+
+// Instance member through a custom delegate: the receiver becomes the delegate's Target.
+// 29. non-eta instance member, custom delegate
+let instanceNonEta (c: C) = DTupled(c.M)
+// 15. eta instance member, custom delegate
+let instanceEta (c: C) = DTupled(fun a b -> c.M a b)
+
+// Generic custom delegate instantiated at int: Invoke(int):int over the generic target.
+// 30. non-eta generic method, generic custom delegate
+let genNonEta () = DGen<int>(ident)
+// 16. eta generic method, generic custom delegate
+let genEta () = DGen<int>(fun x -> ident x)
+
+// byref-parameter custom delegate: the body mutates through the byref, so it is not a transparent forwarding
+// call and stays a closure. Documents that a byref Invoke parameter does not break the recognizer.
+// 53. byref-parameter delegate (mutating body)
+let byrefMutate () = DByref(fun x -> x <- x + 1)