Report the resolved overload for [<CustomOperation>] keywords in QuickInfo and SymbolUse

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

@@ -83,8 +83,8 @@
 * Fix signature conformance: overloaded member with unit parameter `M(())` now matches sig `member M: unit -> unit`. ([Issue #19596](https://github.com/dotnet/fsharp/issues/19596), [PR #19615](https://github.com/dotnet/fsharp/pull/19615))
 * Fix `--quiet` not suppressing NuGet restore output on stdout in F# Interactive ([Issue #18086](https://github.com/dotnet/fsharp/issues/18086))
 * Reference assembly MVIDs are now deterministic across compiler invocations. Previously, `--refout` / `<ProduceReferenceAssembly>true</ProduceReferenceAssembly>` produced a different MVID every build because the implied signature hash used .NET's randomized `String.GetHashCode()`. ([Issue #19751](https://github.com/dotnet/fsharp/issues/19751), [PR #19801](https://github.com/dotnet/fsharp/pull/19801))
-* Parser: recover on unfinished if and binary expressions
-([PR #19724](https://github.com/dotnet/fsharp/pull/19724))
+* Parser: recover on unfinished if and binary expressions ([PR #19724](https://github.com/dotnet/fsharp/pull/19724))
+* Fix QuickInfo / `GetAllUsesOfAllSymbolsInFile` for overloaded CE `[<CustomOperation>]` keywords to report the actually-resolved overload instead of the first-registered one. ([Issue #11612](https://github.com/dotnet/fsharp/issues/11612), [Issue #15206](https://github.com/dotnet/fsharp/issues/15206), [PR #19865](https://github.com/dotnet/fsharp/pull/19865))
 * Fix `open` declaration insertion in `.fsx`/`.fsscript` scripts being placed before `#r`/`#load` directives, producing invalid script files. ([Issue #16271](https://github.com/dotnet/fsharp/issues/16271), [PR #19879](https://github.com/dotnet/fsharp/pull/19879))
 * Warn FS3888 when a compiler-semantic attribute on a value/member or type/module is present in the `.fs` but missing from the `.fsi`. Such attributes were previously ignored at the consumer side. Under the `ErrorOnMissingSignatureAttribute` preview language feature, FS3888 is an error. ([Issue #19560](https://github.com/dotnet/fsharp/issues/19560), [PR #19880](https://github.com/dotnet/fsharp/pull/19880))
 * Emit debug points at a stack-empty position ([PR #19877](https://github.com/dotnet/fsharp/pull/19877))

src/Compiler/Checking/Expressions/CheckComputationExpressions.fs

@@ -7,6 +7,7 @@ module internal FSharp.Compiler.CheckComputationExpressions
 open Internal.Utilities.Library
 open FSharp.Compiler.AccessibilityLogic
 open FSharp.Compiler.AttributeChecking
+open FSharp.Compiler.CheckComputationExpressionsCustomOps
 open FSharp.Compiler.CheckExpressionsOps
 open FSharp.Compiler.CheckExpressions
 open FSharp.Compiler.CheckBasics
@@ -61,6 +62,7 @@ type ComputationExpressionContext<'a> =
         origComp: SynExpr
         mWhole: range
         emptyVarSpace: LazyWithContext<list<Val> * TcEnv, range>
+        deferredCustomOpSinks: ResizeArray<DeferredCustomOpSink>
     }
 
 let inline noTailCall ceenv = { ceenv with tailCall = false }
@@ -178,6 +180,26 @@ let transferVarSpaceReferences (expr: Expr) =
             for v in vals do
                 v.SetHasBeenReferenced()
 
+let TryGetCustomOperationName g m (methInfo: MethInfo) : string option =
+    TryBindMethInfoAttribute
+        g
+        m
+        g.attrib_CustomOperationAttribute
+        methInfo
+        IgnoreAttribute // We do not respect this attribute for IL methods
+        (fun attr ->
+            // NOTE: right now, we support of custom operations with spaces in them ([<CustomOperation("foo bar")>])
+            // In the parameterless CustomOperationAttribute - we use the method name, and also allow it to be ````-quoted (member _.``foo bar`` _ = ...)
+            match attr with
+            // Empty string and parameterless constructor - we use the method name
+            | Attrib(unnamedArgs = [ AttribStringArg "" ]) // Empty string as parameter
+            | Attrib(unnamedArgs = []) -> // No parameters, same as empty string for compat reasons.
+                Some methInfo.LogicalName
+            // Use the specified name
+            | Attrib(unnamedArgs = [ AttribStringArg msg ]) -> Some msg
+            | _ -> None)
+        IgnoreAttribute // We do not respect this attribute for provided methods
+
 let hasMethInfo nm cenv env mBuilderVal ad builderTy =
     match TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBuilderVal ad nm builderTy with
     | [] -> false
@@ -198,25 +220,7 @@ let getCustomOperationMethods (cenv: TcFileState) (env: TcEnv) ad mBuilderVal bu
     [
         for methInfo in allMethInfos do
             if IsMethInfoAccessible cenv.amap mBuilderVal ad methInfo then
-                let nameSearch =
-                    TryBindMethInfoAttribute
-                        cenv.g
-                        mBuilderVal
-                        cenv.g.attrib_CustomOperationAttribute
-                        methInfo
-                        IgnoreAttribute // We do not respect this attribute for IL methods
-                        (fun attr ->
-                            // NOTE: right now, we support of custom operations with spaces in them ([<CustomOperation("foo bar")>])
-                            // In the parameterless CustomOperationAttribute - we use the method name, and also allow it to be ````-quoted (member _.``foo bar`` _ = ...)
-                            match attr with
-                            // Empty string and parameterless constructor - we use the method name
-                            | Attrib(unnamedArgs = [ AttribStringArg "" ]) // Empty string as parameter
-                            | Attrib(unnamedArgs = []) -> // No parameters, same as empty string for compat reasons.
-                                Some methInfo.LogicalName
-                            // Use the specified name
-                            | Attrib(unnamedArgs = [ AttribStringArg msg ]) -> Some msg
-                            | _ -> None)
-                        IgnoreAttribute // We do not respect this attribute for provided methods
+                let nameSearch = TryGetCustomOperationName cenv.g mBuilderVal methInfo
 
                 match nameSearch with
                 | None -> ()
@@ -1124,15 +1128,16 @@ let rec TryTranslateComputationExpression
                 | Some opDatas ->
                     let opName, _, _, _, _, _, _, _, methInfo = opDatas[0]
 
-                    // Record the resolution of the custom operation for posterity
-                    let item =
-                        Item.CustomOperation(opName, (fun () -> customOpUsageText ceenv nm), Some methInfo)
-
-                    // FUTURE: consider whether we can do better than emptyTyparInst here, in order to display instantiations
-                    // of type variables in the quick info provided in the IDE.
-                    CallNameResolutionSink
-                        cenv.tcSink
-                        (nm.idRange, ceenv.env.NameEnv, item, emptyTyparInst, ItemOccurrence.Use, ceenv.env.eAccessRights)
+                    enqueueDeferredCustomOpSink
+                        ceenv.cenv.tcSink
+                        ceenv.env.NameEnv
+                        ceenv.env.eAccessRights
+                        ceenv.deferredCustomOpSinks
+                        nm
+                        opName
+                        (fun () -> customOpUsageText ceenv nm)
+                        (mOpCore.MakeSynthetic())
+                        methInfo
 
                     let mkJoinExpr keySelector1 keySelector2 innerPat e =
                         let mSynthetic = mOpCore.MakeSynthetic()
@@ -2430,15 +2435,16 @@ and ConsumeCustomOpClauses
 
         let isLikeGroupJoin = customOperationIsLikeZip ceenv nm
 
-        // Record the resolution of the custom operation for posterity
-        let item =
-            Item.CustomOperation(opName, (fun () -> customOpUsageText ceenv nm), Some methInfo)
-
-        // FUTURE: consider whether we can do better than emptyTyparInst here, in order to display instantiations
-        // of type variables in the quick info provided in the IDE.
-        CallNameResolutionSink
+        enqueueDeferredCustomOpSink
             ceenv.cenv.tcSink
-            (nm.idRange, ceenv.env.NameEnv, item, emptyTyparInst, ItemOccurrence.Use, ceenv.env.eAccessRights)
+            ceenv.env.NameEnv
+            ceenv.env.eAccessRights
+            ceenv.deferredCustomOpSinks
+            nm
+            opName
+            (fun () -> customOpUsageText ceenv nm)
+            (mClause.MakeSynthetic())
+            methInfo
 
         if isLikeZip || isLikeJoin || isLikeGroupJoin then
             errorR (Error(FSComp.SR.tcBinaryOperatorRequiresBody (nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange))
@@ -3024,6 +3030,8 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv
 
     let origComp = comp
 
+    let deferredCustomOpSinks = ResizeArray<DeferredCustomOpSink>()
+
     let ceenv =
         {
             cenv = cenv
@@ -3041,6 +3049,7 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv
             origComp = origComp
             mWhole = mWhole
             emptyVarSpace = LazyWithContext.NotLazy([], env)
+            deferredCustomOpSinks = deferredCustomOpSinks
         }
 
     /// Inside the 'query { ... }' use a modified name environment that contains fake 'CustomOperation' entries
@@ -3114,7 +3123,8 @@ let TcComputationExpression (cenv: TcFileState) env (overallTy: OverallTy) tpenv
         | _ -> env
 
     let lambdaExpr, tpenv =
-        TcExpr cenv (MustEqual(mkFunTy cenv.g builderTy overallTy)) env tpenv lambdaExpr
+        captureCustomOperationOverloads cenv.tcSink deferredCustomOpSinks (fun () ->
+            TcExpr cenv (MustEqual(mkFunTy cenv.g builderTy overallTy)) env tpenv lambdaExpr)
 
     // For queries, transfer HasBeenReferenced from compiler-generated varSpace Vals to user Vals
     if isQuery then

src/Compiler/Checking/Expressions/CheckComputationExpressionsCustomOps.fs

@@ -0,0 +1,125 @@
+// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
+
+/// Sinks the resolved overload's `MethInfo` at the keyword range of an overloaded
+/// `[<CustomOperation>]` usage in a computation expression — fixes #11612 / #15206.
+module internal FSharp.Compiler.CheckComputationExpressionsCustomOps
+
+open System.Collections.Generic
+open FSharp.Compiler.AccessibilityLogic
+open FSharp.Compiler.Infos
+open FSharp.Compiler.NameResolution
+open FSharp.Compiler.Syntax
+open FSharp.Compiler.Text
+open FSharp.Compiler.TypedTree
+open FSharp.Compiler.TypedTreeOps
+
+[<NoComparison; NoEquality>]
+type DeferredCustomOpSink =
+    {
+        KeywordRange: range
+        OpName: string
+        UsageText: unit -> string option
+        SyntheticCallRange: range
+        Fallback: MethInfo
+        NameEnv: NameResolutionEnv
+        AccessRights: AccessorDomain
+    }
+
+let private makeCustomOpResolutionCapturingSink
+    (forwardTo: ITypecheckResultsSink)
+    (capturedResolutions: Dictionary<range, string * MethInfo * TyparInstantiation>)
+    : ITypecheckResultsSink =
+
+    let tryCapture (m: range) (item: Item) (tpinst: TyparInstantiation) =
+        match item with
+        | Item.MethodGroup(name, [ mi ], _) ->
+            match capturedResolutions.TryGetValue m with
+            | true, (expectedName, _, _) when name = expectedName -> capturedResolutions[m] <- (expectedName, mi, tpinst)
+            | _ -> ()
+        | _ -> ()
+
+    { new ITypecheckResultsSink with
+        member _.NotifyEnvWithScope(m, nenv, ad) =
+            forwardTo.NotifyEnvWithScope(m, nenv, ad)
+
+        member _.NotifyExprHasType(ty, nenv, ad, m) =
+            forwardTo.NotifyExprHasType(ty, nenv, ad, m)
+
+        member _.NotifyExprHasTypeSynthetic(ty, nenv, ad, m) =
+            forwardTo.NotifyExprHasTypeSynthetic(ty, nenv, ad, m)
+
+        member _.NotifyNameResolution(endPos, item, tpinst, occurrenceType, nenv, ad, m, replace) =
+            tryCapture m item tpinst
+            forwardTo.NotifyNameResolution(endPos, item, tpinst, occurrenceType, nenv, ad, m, replace)
+
+        member _.NotifyMethodGroupNameResolution(endPos, item, itemMethodGroup, tpinst, occurrenceType, nenv, ad, m, replace) =
+            tryCapture m item tpinst
+            forwardTo.NotifyMethodGroupNameResolution(endPos, item, itemMethodGroup, tpinst, occurrenceType, nenv, ad, m, replace)
+
+        member _.NotifyFormatSpecifierLocation(m, numArgs) =
+            forwardTo.NotifyFormatSpecifierLocation(m, numArgs)
+
+        member _.NotifyRelatedSymbolUse(m, item, kind) =
+            forwardTo.NotifyRelatedSymbolUse(m, item, kind)
+
+        member _.NotifyOpenDeclaration openDeclaration =
+            forwardTo.NotifyOpenDeclaration openDeclaration
+
+        member _.CurrentSourceText = forwardTo.CurrentSourceText
+
+        member _.FormatStringCheckContext = forwardTo.FormatStringCheckContext
+    }
+
+let enqueueDeferredCustomOpSink
+    (sink: TcResultsSink)
+    (nenv: NameResolutionEnv)
+    (ad: AccessorDomain)
+    (queue: ResizeArray<DeferredCustomOpSink>)
+    (nm: Ident)
+    opName
+    usageText
+    syntheticCallRange
+    (fallback: MethInfo)
+    =
+    let fallbackItem = Item.CustomOperation(opName, usageText, Some fallback)
+
+    CallNameResolutionSink sink (nm.idRange, nenv, fallbackItem, emptyTyparInst, ItemOccurrence.Use, ad)
+
+    queue.Add
+        {
+            KeywordRange = nm.idRange
+            OpName = opName
+            UsageText = usageText
+            SyntheticCallRange = syntheticCallRange
+            Fallback = fallback
+            NameEnv = nenv
+            AccessRights = ad
+        }
+
+let captureCustomOperationOverloads (sink: TcResultsSink) (queue: ResizeArray<DeferredCustomOpSink>) (action: unit -> 'T) : 'T =
+    match sink.CurrentSink with
+    | Some oldSink when queue.Count > 0 ->
+        let capturedResolutions =
+            Dictionary<range, string * MethInfo * TyparInstantiation>(Range.comparer)
+
+        for entry in queue do
+            capturedResolutions[entry.SyntheticCallRange] <- (entry.Fallback.LogicalName, entry.Fallback, emptyTyparInst)
+
+        let captureSink = makeCustomOpResolutionCapturingSink oldSink capturedResolutions
+
+        let result =
+            use _holder = WithNewTypecheckResultsSink(captureSink, sink)
+            action ()
+
+        for entry in queue do
+            let _, resolved, tpinst = capturedResolutions[entry.SyntheticCallRange]
+
+            if not (MethInfo.MethInfosUseIdenticalDefinitions resolved entry.Fallback) then
+                let item = Item.CustomOperation(entry.OpName, entry.UsageText, Some resolved)
+
+                CallNameResolutionSinkReplacing
+                    sink
+                    (entry.KeywordRange, entry.NameEnv, item, tpinst, ItemOccurrence.Use, entry.AccessRights)
+
+        result
+    | _ -> action ()

src/Compiler/FSharp.Compiler.Service.fsproj

@@ -407,6 +407,7 @@
     <Compile Include="Checking\Expressions\CheckExpressions.fs" />
     <Compile Include="Checking\CheckPatterns.fsi" />
     <Compile Include="Checking\CheckPatterns.fs" />
+    <Compile Include="Checking\Expressions\CheckComputationExpressionsCustomOps.fs" />
     <Compile Include="Checking\Expressions\CheckComputationExpressions.fsi" />
     <Compile Include="Checking\Expressions\CheckComputationExpressions.fs" />
     <Compile Include="Checking\Expressions\CheckSequenceExpressions.fs" />