Add symbol and type highlighting to F# diagnostics

FSharpBuild.Directory.Build.targets

@@ -104,6 +104,32 @@
   <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)')" />   
 
+  <!-- Proto has no Bootstrap to redirect to, so it would otherwise resolve the tasks from the SDK's
+       FSharp.Build, which is a released copy and does not include this repo's changes to them. Use the
+       one built here instead; proto.proj builds FSharp.Build before anything that consumes the tasks. -->
+  <PropertyGroup Condition="'$(Configuration)' == 'Proto'">
+    <ProtoFSharpBuildAssemblyFile>$(ArtifactsDir)bin\FSharp.Build\Proto\netstandard2.0\FSharp.Build.dll</ProtoFSharpBuildAssemblyFile>
+  </PropertyGroup>
+  <UsingTask TaskName="FSharpEmbedResourceText" AssemblyFile="$(ProtoFSharpBuildAssemblyFile)" Override="true" Condition="'$(Configuration)' == 'Proto' AND Exists('$(ProtoFSharpBuildAssemblyFile)')" />
+
+  <!-- A build with no Bootstrap to redirect to either, e.g. a plain build of FSharp.Compiler.Service.slnx,
+       would resolve the task from the SDK's FSharp.Build as well, and the classified resource accessors
+       FSComp.txt is compiled with would be missing from the generated source. Use the one built here.
+       Unlike the cases above there is nothing that builds it beforehand, and resource generation runs
+       before references are resolved, so a ProjectReference would be too late: the target below builds it,
+       and the task is registered unconditionally so that a missing assembly is reported rather than
+       silently falling back to the SDK's copy. -->
+  <PropertyGroup Condition="'$(Configuration)' != 'Proto' AND '$(MSBuildProjectName)' == 'FSharp.Compiler.Service' AND !Exists('$(ProtoOutputPath)')">
+    <LocalFSharpBuildAssemblyFile>$(ArtifactsDir)bin\FSharp.Build\$(Configuration)\netstandard2.0\FSharp.Build.dll</LocalFSharpBuildAssemblyFile>
+  </PropertyGroup>
+  <UsingTask TaskName="FSharpEmbedResourceText" AssemblyFile="$(LocalFSharpBuildAssemblyFile)" Override="true" Condition="'$(LocalFSharpBuildAssemblyFile)' != ''" />
+
+  <Target Name="BuildFSharpBuildForResourceGeneration"
+          BeforeTargets="GenerateFSharpTextResources"
+          Condition="'$(LocalFSharpBuildAssemblyFile)' != '' AND !Exists('$(LocalFSharpBuildAssemblyFile)')">
+    <MSBuild Projects="$(RepoRoot)src\FSharp.Build\FSharp.Build.fsproj" RemoveProperties="TargetFramework" />
+  </Target>
+
 
   <Target Name="BeforeResGen"
           Inputs="@(EmbeddedResource->'$(IntermediateOutputPath)%(Filename)%(Extension)')"

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,6 +14,7 @@ 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
@@ -489,7 +490,17 @@ let convResolveAssemblyRef (cenv: cenv) (asmref: ILAssemblyRef) qualifiedName =
     let typT = assembly.GetType qualifiedName
 
     match typT with
-    | null -> error (Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", qualifiedName, asmref.QualifiedName), range0))
+    | null ->
+        error (
+            RichError(
+                FSComp.SR.itemNotFoundDuringDynamicCodeGen (
+                    RichText.mkText "type",
+                    RichText.mkQualifiedTypeName qualifiedName,
+                    RichText.mkText asmref.QualifiedName
+                ),
+                range0
+            )
+        )
     | res -> res
 
 /// Convert an Abstract IL type reference to Reflection.Emit System.Type value.
@@ -510,7 +521,17 @@ let convTypeRefAux (cenv: cenv) (tref: ILTypeRef) =
         let typT = Type.GetType qualifiedName
 
         match typT with
-        | null -> error (Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", qualifiedName, "<emitted>"), range0))
+        | null ->
+            error (
+                RichError(
+                    FSComp.SR.itemNotFoundDuringDynamicCodeGen (
+                        RichText.mkText "type",
+                        RichText.mkQualifiedTypeName qualifiedName,
+                        RichText.mkText "<emitted>"
+                    ),
+                    range0
+                )
+            )
         | res -> res
     | ILScopeRef.PrimaryAssembly -> convResolveAssemblyRef cenv cenv.ilg.primaryAssemblyRef qualifiedName
 
@@ -705,7 +726,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 (
+            RichError(
+                FSComp.SR.itemNotFoundDuringDynamicCodeGen (
+                    RichText.mkText "type",
+                    RichText.mkUnknownType tspec.TypeRef.QualifiedName,
+                    RichText.mkText tspec.Scope.QualifiedName
+                ),
+                range0
+            )
+        )
     | NonNull res -> res
 
 and convTypeAux cenv emEnv preferCreated ty =
@@ -835,12 +865,12 @@ let queryableTypeGetField _emEnv (parentT: Type) (fref: ILFieldRef) =
     match res with
     | Null ->
         error (
-            Error(
+            RichError(
                 FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen (
-                    "field",
-                    fref.Name,
-                    fref.DeclaringTypeRef.FullName,
-                    fref.DeclaringTypeRef.Scope.QualifiedName
+                    RichText.mkText "field",
+                    RichText.mkMember fref.Name,
+                    RichText.mkQualifiedTypeName fref.DeclaringTypeRef.FullName,
+                    RichText.mkText fref.DeclaringTypeRef.Scope.QualifiedName
                 ),
                 range0
             )
@@ -1044,12 +1074,12 @@ let convMethodRef cenv emEnv (parentTI: Type) (mref: ILMethodRef) =
     match res with
     | Null ->
         error (
-            Error(
+            RichError(
                 FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen (
-                    "method",
-                    mref.Name,
-                    parentTI.FullName |> string,
-                    parentTI.Assembly.FullName |> string
+                    RichText.mkText "method",
+                    RichText.mkMember mref.Name,
+                    RichText.mkQualifiedTypeName (parentTI.FullName |> string),
+                    RichText.mkText (parentTI.Assembly.FullName |> string)
                 ),
                 range0
             )
@@ -1090,12 +1120,12 @@ let queryableTypeGetConstructor cenv emEnv (parentT: Type) (mref: ILMethodRef) =
     match res with
     | Null ->
         error (
-            Error(
+            RichError(
                 FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen (
-                    "constructor",
-                    mref.Name,
-                    parentT.FullName |> string,
-                    parentT.Assembly.FullName |> string
+                    RichText.mkText "constructor",
+                    RichText.mkMember mref.Name,
+                    RichText.mkQualifiedTypeName (parentT.FullName |> string),
+                    RichText.mkText (parentT.Assembly.FullName |> string)
                 ),
                 range0
             )
@@ -1130,12 +1160,12 @@ let convConstructorSpec cenv emEnv (mspec: ILMethodSpec) =
     match res with
     | Null ->
         error (
-            Error(
+            RichError(
                 FSComp.SR.itemNotFoundInTypeDuringDynamicCodeGen (
-                    "constructor",
-                    "",
-                    parentTI.FullName |> string,
-                    parentTI.Assembly.FullName |> string
+                    RichText.mkText "constructor",
+                    RichText.mkMember "",
+                    RichText.mkQualifiedTypeName (parentTI.FullName |> string),
+                    RichText.mkText (parentTI.Assembly.FullName |> string)
                 ),
                 range0
             )

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(RichError(FSComp.SR.tooManyMethodsInDotNetTypeWritingAssembly (RichText.mkQualifiedTypeName 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(RichError(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 (RichError(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 (RichError(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 (RichError(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 (RichError(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 (RichError(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

@@ -260,7 +260,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
@@ -393,7 +393,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 
@@ -611,7 +611,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(RichError(FSComp.SR.tcFunctionRequiresExplicitTypeArguments(RichText.mkMethod minfo.LogicalName), m))
                         }
 
                     Some res)