Add symbol and type highlighting to F# diagnostics

FSharpBuild.Directory.Build.targets

@@ -97,12 +97,23 @@
     </ItemGroup>
   </Target>
 
-      <!-- SDK targets override -->
-  <PropertyGroup Condition="'$(Configuration)' != 'Proto' AND '$(DisableCompilerRedirection)'!='true' AND Exists('$(ProtoOutputPath)')">
-    <FSharpBuildAssemblyFileOverride>$(ProtoOutputPath)\fsc\FSharp.Build.dll</FSharpBuildAssemblyFileOverride>
-  </PropertyGroup>  
-  <UsingTask TaskName="FSharpEmbedResourceText" AssemblyFile="$(FSharpBuildAssemblyFileOverride)" Override="true" Condition="'$(Configuration)' != 'Proto' AND '$(DisableCompilerRedirection)'!='true' AND Exists('$(ProtoOutputPath)')" />
-  <UsingTask TaskName="FSharpEmbedResXSource" AssemblyFile="$(FSharpBuildAssemblyFileOverride)" Override="true" Condition="'$(Configuration)' != 'Proto' AND '$(DisableCompilerRedirection)'!='true' AND Exists('$(ProtoOutputPath)')" />   
+  <!-- SDK targets override: the SDK's released FSharp.Build cannot generate the classified resource
+       accessors FSComp.txt is compiled with, so the tasks come from the Bootstrap, or from this repo's own
+       build for projects opting in - FSharp.Build itself cannot, its FSBuild.txt would need its own output
+       before it is built. No Exists check, so a missing assembly is an error rather than a silent fallback
+       to the SDK's. TaskHostFactory keeps the node from locking what it loads. -->
+  <PropertyGroup>
+    <FSharpBuildTasksAssembly Condition="'$(Configuration)' != 'Proto' AND '$(DisableCompilerRedirection)' != 'true' AND Exists('$(ProtoOutputPath)')">$(ProtoOutputPath)\fsc\FSharp.Build.dll</FSharpBuildTasksAssembly>
+    <FSharpBuildTasksAssembly Condition="'$(FSharpBuildTasksAssembly)' == '' AND '$(UseBootstrappedFSharpBuildTasks)' == 'true'">$(ArtifactsDir)bin\FSharp.Build\$(Configuration)\netstandard2.0\FSharp.Build.dll</FSharpBuildTasksAssembly>
+  </PropertyGroup>
+  <UsingTask TaskName="FSharpEmbedResourceText" AssemblyFile="$(FSharpBuildTasksAssembly)" Override="true" TaskFactory="TaskHostFactory" Condition="'$(FSharpBuildTasksAssembly)' != ''" />
+  <UsingTask TaskName="FSharpEmbedResXSource" AssemblyFile="$(FSharpBuildTasksAssembly)" Override="true" TaskFactory="TaskHostFactory" Condition="'$(FSharpBuildTasksAssembly)' != ''" />
+
+  <Target Name="BuildFSharpBuildForResourceGeneration"
+          BeforeTargets="GenerateFSharpTextResources"
+          Condition="'$(UseBootstrappedFSharpBuildTasks)' == 'true' AND '$(FSharpBuildTasksAssembly)' != '' AND !Exists('$(FSharpBuildTasksAssembly)')">
+    <MSBuild Projects="$(RepoRoot)src\FSharp.Build\FSharp.Build.fsproj" RemoveProperties="TargetFramework" />
+  </Target>
 
 
   <Target Name="BeforeResGen"

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

@@ -154,6 +154,7 @@
 * Add Roslyn-format EnC CustomDebugInformation codec and portable PDB method CDI emission support to AbstractIL. ([PR #20018](https://github.com/dotnet/fsharp/pull/20018))
 * Support for the `<include>` XML documentation tag: at compile time, documentation is copied from an external XML file selected by an XPath query and emitted into the generated documentation file. `<inheritdoc>` remains unsupported. ([Issue #19175](https://github.com/dotnet/fsharp/issues/19175), [PR #19186](https://github.com/dotnet/fsharp/pull/19186))
 * Expand `<inheritdoc/>` at tooling time. In IDE tooltips, completion, and signature help, documentation is inherited from base classes, interfaces, overridden members, and constructors (matched by parameter signature). The FCS Symbols API (`FSharpSymbol.XmlDoc`) additionally resolves explicit `cref` targets, but does not expand constructor inheritance. The compiler emits the tag verbatim into generated XML documentation files, matching C#; `<include>` is not implemented. ([Issue #19175](https://github.com/dotnet/fsharp/issues/19175), [PR #19188](https://github.com/dotnet/fsharp/pull/19188))
+* Add symbol and type highlighting to F# diagnostics ([PR #20097](https://github.com/dotnet/fsharp/pull/20097))
 
 ### Improved
 

proto.proj

@@ -5,6 +5,7 @@
   </PropertyGroup>
 
   <ItemGroup>
+    <Projects Include="src\FSharp.Build\FSharp.Build.fsproj" />
     <Projects Include="buildtools\fslex\fslex.fsproj" />
     <Projects Include="buildtools\fsyacc\fsyacc.fsproj" />
     <Projects Include="buildtools\AssemblyCheck\AssemblyCheck.fsproj" />

src/Compiler/AbstractIL/ilreflect.fs

@@ -14,12 +14,18 @@ open Internal.Utilities.Library
 open FSharp.Compiler.AbstractIL.Diagnostics
 open FSharp.Compiler.AbstractIL.IL
 open FSharp.Compiler.DiagnosticsLogger
+open FSharp.Compiler.Text
 open FSharp.Compiler.IO
 open FSharp.Compiler.Text.Range
 open FSharp.Core.Printf
 
 let codeLabelOrder = ComparisonIdentity.Structural<ILCodeLabel>
 
+let richTextOfILTypeRef (tref: ILTypeRef) =
+    tref.Enclosing @ [ tref.Name ]
+    |> List.map RichText.ofQualifiedTypeName
+    |> RichText.concatWith (RichText.mkPunctuation "+")
+
 // Convert the output of convCustomAttr
 let wrapCustomAttr setCustomAttr (cinfo, bytes) = setCustomAttr (cinfo, bytes)
 
@@ -473,7 +479,7 @@ type cenv =
 
     override x.ToString() = "<cenv>"
 
-let convResolveAssemblyRef (cenv: cenv) (asmref: ILAssemblyRef) qualifiedName =
+let convResolveAssemblyRef (cenv: cenv) (asmref: ILAssemblyRef) (tref: ILTypeRef) =
     let assembly =
         match cenv.resolveAssemblyRef asmref with
         | Some(Choice1Of2 path) ->
@@ -486,10 +492,20 @@ let convResolveAssemblyRef (cenv: cenv) (asmref: ILAssemblyRef) qualifiedName =
             let asmName = convAssemblyRef asmref
             FileSystem.AssemblyLoader.AssemblyLoad asmName
 
-    let typT = assembly.GetType qualifiedName
+    let typT = assembly.GetType tref.BasicQualifiedName
 
     match typT with
-    | null -> error (Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", qualifiedName, asmref.QualifiedName), range0))
+    | null ->
+        error (
+            Error(
+                FSComp.SR.itemNotFoundDuringDynamicCodeGen (
+                    RichText.mkText "type",
+                    richTextOfILTypeRef tref,
+                    RichText.mkText asmref.QualifiedName
+                ),
+                range0
+            )
+        )
     | res -> res
 
 /// Convert an Abstract IL type reference to Reflection.Emit System.Type value.
@@ -500,19 +516,26 @@ let convResolveAssemblyRef (cenv: cenv) (asmref: ILAssemblyRef) qualifiedName =
 // [ns]            , name -> ns+name
 // [ns;typeA;typeB], name -> ns+typeA+typeB+name
 let convTypeRefAux (cenv: cenv) (tref: ILTypeRef) =
-    let qualifiedName =
-        (String.concat "+" (tref.Enclosing @ [ tref.Name ])).Replace(",", @"\,")
-
     match tref.Scope with
-    | ILScopeRef.Assembly asmref -> convResolveAssemblyRef cenv asmref qualifiedName
+    | ILScopeRef.Assembly asmref -> convResolveAssemblyRef cenv asmref tref
     | ILScopeRef.Module _
     | ILScopeRef.Local ->
-        let typT = Type.GetType qualifiedName
+        let typT = Type.GetType tref.BasicQualifiedName
 
         match typT with
-        | null -> error (Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", qualifiedName, "<emitted>"), range0))
+        | null ->
+            error (
+                Error(
+                    FSComp.SR.itemNotFoundDuringDynamicCodeGen (
+                        RichText.mkText "type",
+                        richTextOfILTypeRef tref,
+                        RichText.mkText "<emitted>"
+                    ),
+                    range0
+                )
+            )
         | res -> res
-    | ILScopeRef.PrimaryAssembly -> convResolveAssemblyRef cenv cenv.ilg.primaryAssemblyRef qualifiedName
+    | ILScopeRef.PrimaryAssembly -> convResolveAssemblyRef cenv cenv.ilg.primaryAssemblyRef tref
 
 /// The (local) emitter env (state). Some of these fields are effectively global accumulators
 /// and could be placed as hash tables in the global environment.
@@ -705,7 +728,16 @@ let rec convTypeSpec cenv emEnv preferCreated (tspec: ILTypeSpec) =
 
     match res with
     | Null ->
-        error (Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", tspec.TypeRef.QualifiedName, tspec.Scope.QualifiedName), range0))
+        error (
+            Error(
+                FSComp.SR.itemNotFoundDuringDynamicCodeGen (
+                    RichText.mkText "type",
+                    richTextOfILTypeRef tspec.TypeRef,
+                    RichText.mkText tspec.Scope.QualifiedName
+                ),
+                range0
+            )
+        )
     | NonNull res -> res
 
 and convTypeAux cenv emEnv preferCreated ty =
@@ -837,10 +869,10 @@ let queryableTypeGetField _emEnv (parentT: Type) (fref: ILFieldRef) =
         error (
             Error(
                 FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen (
-                    "field",
-                    fref.Name,
-                    fref.DeclaringTypeRef.FullName,
-                    fref.DeclaringTypeRef.Scope.QualifiedName
+                    RichText.mkText "field",
+                    RichText.mkMember fref.Name,
+                    RichText.ofQualifiedTypeName fref.DeclaringTypeRef.FullName,
+                    RichText.mkText fref.DeclaringTypeRef.Scope.QualifiedName
                 ),
                 range0
             )
@@ -1046,10 +1078,10 @@ let convMethodRef cenv emEnv (parentTI: Type) (mref: ILMethodRef) =
         error (
             Error(
                 FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen (
-                    "method",
-                    mref.Name,
-                    parentTI.FullName |> string,
-                    parentTI.Assembly.FullName |> string
+                    RichText.mkText "method",
+                    RichText.mkMember mref.Name,
+                    RichText.ofQualifiedTypeName (parentTI.FullName |> string),
+                    RichText.mkText (parentTI.Assembly.FullName |> string)
                 ),
                 range0
             )
@@ -1092,10 +1124,10 @@ let queryableTypeGetConstructor cenv emEnv (parentT: Type) (mref: ILMethodRef) =
         error (
             Error(
                 FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen (
-                    "constructor",
-                    mref.Name,
-                    parentT.FullName |> string,
-                    parentT.Assembly.FullName |> string
+                    RichText.mkText "constructor",
+                    RichText.mkMember mref.Name,
+                    RichText.ofQualifiedTypeName (parentT.FullName |> string),
+                    RichText.mkText (parentT.Assembly.FullName |> string)
                 ),
                 range0
             )
@@ -1132,10 +1164,10 @@ let convConstructorSpec cenv emEnv (mspec: ILMethodSpec) =
         error (
             Error(
                 FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen (
-                    "constructor",
-                    "",
-                    parentTI.FullName |> string,
-                    parentTI.Assembly.FullName |> string
+                    RichText.mkText "constructor",
+                    RichText.mkMember "",
+                    RichText.ofQualifiedTypeName (parentTI.FullName |> string),
+                    RichText.mkText (parentTI.Assembly.FullName |> string)
                 ),
                 range0
             )

src/Compiler/AbstractIL/ilreflect.fsi

@@ -7,6 +7,11 @@ open System.Reflection
 open System.Reflection.Emit
 
 open FSharp.Compiler.AbstractIL.IL
+open FSharp.Compiler.Text
+
+/// A type reference's name as reflection spells it, classifying the namespace, the enclosing types and
+/// the name itself separately. Only a reference is at hand, so what kind of type it is is not known.
+val richTextOfILTypeRef: tref: ILTypeRef -> RichText
 
 val mkDynamicAssemblyAndModule:
     assemblyName: string * optimize: bool * collectible: bool -> AssemblyBuilder * ModuleBuilder

src/Compiler/AbstractIL/ilsign.fs

@@ -11,6 +11,7 @@ open System.Reflection.PortableExecutable
 open System.Security.Cryptography
 open System.Runtime.InteropServices
 
+open FSharp.Compiler.Text
 open Internal.Utilities.Library
 
 type KeyType =
@@ -33,7 +34,7 @@ let BLOBHEADER_LENGTH = int 20
 let RSA_PUB_MAGIC = int 0x31415352
 let RSA_PRIV_MAGIC = int 0x32415352
 
-let getResourceString (_, str) = str
+let getResourceString (_, message: RichText) = message.Text
 
 [<Struct; StructLayout(LayoutKind.Explicit)>]
 type ByteArrayUnion =
@@ -351,7 +352,7 @@ let signerSignatureSize (pk: pubkey) : int = signatureSize pk
 let signerSignStreamWithKeyPair stream keyBlob = signStream stream keyBlob
 
 let failWithContainerSigningUnsupportedOnThisPlatform () =
-    failwith (FSComp.SR.containerSigningUnsupportedOnThisPlatform () |> snd)
+    failwith (FSComp.SR.containerSigningUnsupportedOnThisPlatform () |> getResourceString)
 
 //---------------------------------------------------------------------
 // Strong name signing

src/Compiler/AbstractIL/ilwrite.fs

@@ -7,6 +7,7 @@ open System.Collections.Generic
 open System.IO
 
 open Internal.Utilities
+open FSharp.Compiler.Text
 open FSharp.Compiler.AbstractIL.IL
 open FSharp.Compiler.AbstractIL.Diagnostics
 open FSharp.Compiler.AbstractIL.BinaryConstants
@@ -694,7 +695,7 @@ let rec GenTypeDefPass1 enc cenv (tdef: ILTypeDef) =
     // Verify that the typedef contains fewer than maximumMethodsPerDotNetType
     let count = tdef.Methods.AsArray().Length
     if count > maximumMethodsPerDotNetType then
-        errorR(Error(FSComp.SR.tooManyMethodsInDotNetTypeWritingAssembly (tdef.Name, count, maximumMethodsPerDotNetType), rangeStartup))
+        errorR(Error(FSComp.SR.tooManyMethodsInDotNetTypeWritingAssembly (RichText.ofQualifiedTypeName tdef.Name, count, maximumMethodsPerDotNetType), rangeStartup))
 
     GenTypeDefsPass1 (enc@[tdef.Name]) cenv (tdef.NestedTypes.AsList())
 

src/Compiler/Checking/AccessibilityLogic.fs

@@ -6,6 +6,7 @@ module internal FSharp.Compiler.AccessibilityLogic
 open Internal.Utilities.Library
 open FSharp.Compiler 
 open FSharp.Compiler.AbstractIL.IL 
+open FSharp.Compiler.Text
 open FSharp.Compiler.DiagnosticsLogger
 open FSharp.Compiler.Import
 open FSharp.Compiler.Infos
@@ -179,7 +180,7 @@ let IsEntityAccessible amap m ad (tcref:TyconRef) =
 let CheckTyconAccessible amap m ad tcref =
     let res = IsEntityAccessible amap m ad tcref
     if not res then  
-        errorR(Error(FSComp.SR.typeIsNotAccessible tcref.DisplayName, m))
+        errorR(Error(FSComp.SR.typeIsNotAccessible (richTextOfEntityRef tcref), m))
     res
 
 /// Indicates if a type definition and its representation contents are accessible
@@ -192,7 +193,7 @@ let CheckTyconReprAccessible amap m ad tcref =
     CheckTyconAccessible amap m ad tcref &&
     (let res = IsAccessible ad tcref.TypeReprAccessibility
      if not res then 
-         errorR (Error (FSComp.SR.unionCasesAreNotAccessible tcref.DisplayName, m))
+         errorR (Error(FSComp.SR.unionCasesAreNotAccessible (richTextOfEntityRef tcref), m))
      res)
 
 /// Indicates if a type is accessible (both definition and instantiation)
@@ -338,9 +339,9 @@ let IsILPropInfoAccessible g amap m ad pinfo =
 let IsValAccessible ad (vref:ValRef) = 
     vref.Accessibility |> IsAccessible ad
 
-let CheckValAccessible  m ad (vref:ValRef) = 
+let CheckValAccessible g m ad (vref:ValRef) = 
     if not (IsValAccessible ad vref) then 
-        errorR (Error (FSComp.SR.valueIsNotAccessible vref.DisplayName, m))
+        errorR (Error(FSComp.SR.valueIsNotAccessible (richTextOfValName g vref.Deref), m))
 
 let IsUnionCaseAccessible amap m ad (ucref:UnionCaseRef) =
     IsTyconReprAccessible amap m ad ucref.TyconRef &&
@@ -350,7 +351,7 @@ let CheckUnionCaseAccessible amap m ad (ucref:UnionCaseRef) =
     CheckTyconReprAccessible amap m ad ucref.TyconRef &&
     (let res = IsAccessible ad ucref.UnionCase.Accessibility
      if not res then 
-        errorR (Error (FSComp.SR.unionCaseIsNotAccessible ucref.CaseName, m))
+        errorR (Error(FSComp.SR.unionCaseIsNotAccessible (RichText.mkUnionCase ucref.CaseName), m))
      res)
 
 let IsRecdFieldAccessible amap m ad (rfref:RecdFieldRef) =
@@ -361,15 +362,15 @@ let CheckRecdFieldAccessible amap m ad (rfref:RecdFieldRef) =
     CheckTyconReprAccessible amap m ad rfref.TyconRef &&
     (let res = IsAccessible ad rfref.RecdField.Accessibility
      if not res then 
-        errorR (Error (FSComp.SR.fieldIsNotAccessible rfref.FieldName, m))
+        errorR (Error(FSComp.SR.fieldIsNotAccessible (RichText.mkRecordField rfref.FieldName), m))
      res)
 
 let CheckRecdFieldInfoAccessible amap m ad (rfinfo:RecdFieldInfo) = 
     CheckRecdFieldAccessible amap m ad rfinfo.RecdFieldRef |> ignore
 
 let CheckILFieldInfoAccessible g amap m ad finfo =
     if not (IsILFieldInfoAccessible g amap m ad finfo) then 
-        errorR (Error (FSComp.SR.structOrClassFieldIsNotAccessible finfo.FieldName, m))
+        errorR (Error(FSComp.SR.structOrClassFieldIsNotAccessible (RichText.mkField finfo.FieldName), m))
 
 /// Uses a separate accessibility domains for containing type and method itself
 /// This makes sense cases like

src/Compiler/Checking/AccessibilityLogic.fsi

@@ -86,7 +86,7 @@ val IsILPropInfoAccessible:
 
 val IsValAccessible: ad: AccessorDomain -> vref: ValRef -> bool
 
-val CheckValAccessible: m: range -> ad: AccessorDomain -> vref: ValRef -> unit
+val CheckValAccessible: g: TcGlobals -> m: range -> ad: AccessorDomain -> vref: ValRef -> unit
 
 val IsUnionCaseAccessible: amap: ImportMap -> m: range -> ad: AccessorDomain -> ucref: TypedTree.UnionCaseRef -> bool
 

src/Compiler/Checking/AttributeChecking.fs

@@ -263,7 +263,7 @@ let MethInfoHasWellKnownAttributeSpec (g: TcGlobals) (m: range) (spec: WellKnown
 let private reportObsoleteDiagnostic m diagnostic =
     match diagnostic with
     | Some(ObsoleteDiagnosticInfo(isError, id, msg, urlFormat)) ->
-        let obsoleteDiagnostic = ObsoleteDiagnostic(isError, id, msg, urlFormat, m)
+        let obsoleteDiagnostic = ObsoleteDiagnostic(isError, id, msg |> Option.map RichText.mkText, urlFormat, m)
         if isError then
             ErrorD(obsoleteDiagnostic)
         else
@@ -396,7 +396,7 @@ let private CheckCompilerMessageAttribute g attribs m =
     trackErrors {
         match attribs with
         | EntityAttrib g WellKnownEntityAttributes.CompilerMessageAttribute (Attrib(unnamedArgs= [ AttribStringArg s ; AttribInt32Arg n ]; propVal= namedArgs)) ->
-            let msg = UserCompilerMessage(s, n, m)
+            let msg = UserCompilerMessage(RichText.mkText s, n, m)
             let isError = 
                 match namedArgs with 
                 | ExtractAttribNamedArg "IsError" (AttribBoolArg v) -> v 
@@ -614,7 +614,7 @@ let CheckMethInfoAttributes g m tyargsOpt (minfo: MethInfo) =
                         trackErrors {
                              do! CheckFSharpAttributes g fsAttribs m
                              if Option.isNone tyargsOpt && (attribsHaveValFlag g WellKnownValAttributes.RequiresExplicitTypeArgumentsAttribute fsAttribs) then
-                                do! ErrorD(Error(FSComp.SR.tcFunctionRequiresExplicitTypeArguments(minfo.LogicalName), m))
+                                do! ErrorD(Error(FSComp.SR.tcFunctionRequiresExplicitTypeArguments(RichText.mkMethod minfo.LogicalName), m))
                         }
 
                     Some res)