diff --git a/FSharpBuild.Directory.Build.targets b/FSharpBuild.Directory.Build.targets
index aca30e3a86c..238758146a1 100644
--- a/FSharpBuild.Directory.Build.targets
+++ b/FSharpBuild.Directory.Build.targets
@@ -104,6 +104,27 @@
+
+
+ $(ArtifactsDir)bin\FSharp.Build\$(Configuration)\netstandard2.0\FSharp.Build.dll
+
+
+
+
+
+
+
+
diff --git a/src/Compiler/AbstractIL/ilreflect.fs b/src/Compiler/AbstractIL/ilreflect.fs
index eab257c1573..4722c50cce5 100644
--- a/src/Compiler/AbstractIL/ilreflect.fs
+++ b/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, ""), range0))
+ | null ->
+ error (
+ RichError(
+ FSComp.SR.itemNotFoundDuringDynamicCodeGen (
+ RichText.mkText "type",
+ RichText.mkQualifiedTypeName qualifiedName,
+ RichText.mkText ""
+ ),
+ 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
)
diff --git a/src/Compiler/AbstractIL/ilwrite.fs b/src/Compiler/AbstractIL/ilwrite.fs
index bf6277bf485..a2ddb866b7b 100644
--- a/src/Compiler/AbstractIL/ilwrite.fs
+++ b/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())
diff --git a/src/Compiler/Checking/AccessibilityLogic.fs b/src/Compiler/Checking/AccessibilityLogic.fs
index 3c076513765..b4fe8111fd3 100644
--- a/src/Compiler/Checking/AccessibilityLogic.fs
+++ b/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,7 +362,7 @@ 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) =
@@ -369,7 +370,7 @@ let CheckRecdFieldInfoAccessible amap m ad (rfinfo:RecdFieldInfo) =
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
diff --git a/src/Compiler/Checking/AccessibilityLogic.fsi b/src/Compiler/Checking/AccessibilityLogic.fsi
index 3f05f0d1417..2f8bfc4eb41 100644
--- a/src/Compiler/Checking/AccessibilityLogic.fsi
+++ b/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
diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs
index 87621466329..a5c7729d55d 100755
--- a/src/Compiler/Checking/AttributeChecking.fs
+++ b/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)
diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs
index dfa348ab19f..50089e89e55 100644
--- a/src/Compiler/Checking/CheckDeclarations.fs
+++ b/src/Compiler/Checking/CheckDeclarations.fs
@@ -407,7 +407,7 @@ let CheckDuplicates (idf: _ -> Ident) k elems =
let private CheckDuplicatesArgNames (synVal: SynValSig) m =
let argNames = synVal.SynInfo.ArgNames |> List.duplicates
for name in argNames do
- errorR(Error((FSComp.SR.chkDuplicatedMethodParameter(name), m)))
+ errorR(RichError(FSComp.SR.chkDuplicatedMethodParameter(RichText.mkParameter name), m))
let private CheckDuplicatesAbstractMethodParamsSig (typeSpecs: SynTypeDefnSig list) =
for SynTypeDefnSig(typeRepr= trepr) in typeSpecs do
@@ -511,7 +511,7 @@ module TcRecdUnionAndEnumDeclarations =
let g = cenv.g
let name = id.idText
if name = "Tags" then
- errorR(Error(FSComp.SR.tcUnionCaseNameConflictsWithGeneratedType(name, "Tags"), id.idRange))
+ errorR(RichError(FSComp.SR.tcUnionCaseNameConflictsWithGeneratedType(RichText.mkUnionCase name, RichText.mkClass "Tags"), id.idRange))
CheckNamespaceModuleOrTypeName g id
@@ -527,7 +527,7 @@ module TcRecdUnionAndEnumDeclarations =
elems |> List.iteri (fun i (uc1: Ident) ->
elems |> List.iteri (fun j (uc2: Ident) ->
if j > i && uc1.idText = uc2.idText then
- errorR(Error(FSComp.SR.tcFieldNameIsUsedModeThanOnce(uc1.idText), uc1.idRange))))
+ errorR(RichError(FSComp.SR.tcFieldNameIsUsedModeThanOnce(RichText.mkRecordField uc1.idText), uc1.idRange))))
let ValidateFieldNames (synFields: SynField list, tastFields: RecdField list) =
let fields = synFields |> List.choose (function SynField(idOpt = Some ident) -> Some ident | _ -> None)
@@ -541,7 +541,7 @@ module TcRecdUnionAndEnumDeclarations =
match sf, synField with
| SynField(idOpt = Some id), SynField(idOpt = None)
| SynField(idOpt = None), SynField(idOpt = Some id) ->
- errorR(Error(FSComp.SR.tcFieldNameConflictsWithGeneratedNameForAnonymousField(id.idText), id.idRange))
+ errorR(RichError(FSComp.SR.tcFieldNameConflictsWithGeneratedNameForAnonymousField(RichText.mkRecordField id.idText), id.idRange))
| _ -> ()
| _ ->
seen.Add(f.LogicalName, sf))
@@ -687,7 +687,7 @@ let PublishInterface (cenv: cenv) denv (tcref: TyconRef) m isCompGen interfaceTy
let g = cenv.g
if not (isInterfaceTy g interfaceTy) then
- errorR(Error(FSComp.SR.tcTypeIsNotInterfaceType1(NicePrint.minimalStringOfType denv interfaceTy), m))
+ errorR(RichError(FSComp.SR.tcTypeIsNotInterfaceType1(NicePrint.minimalRichTextOfType denv interfaceTy), m))
if tcref.HasInterface g interfaceTy then
errorR(Error(FSComp.SR.tcDuplicateSpecOfInterface(), m))
@@ -767,13 +767,13 @@ let TcOpenModuleOrNamespaceDecl tcSink g amap scopem env (longId, m) =
modrefs |> List.iter (fun (_, modref, _) ->
if modref.IsModule && EntityHasWellKnownAttribute g WellKnownEntityAttributes.RequireQualifiedAccessAttribute modref.Deref then
- errorR(Error(FSComp.SR.tcModuleRequiresQualifiedAccess(fullDisplayTextOfModRef modref), m)))
+ errorR(RichError(FSComp.SR.tcModuleRequiresQualifiedAccess(richTextOfQualifiedModRef modref), m)))
// Bug FSharp 1.0 3133: 'open Lexing'. Skip this warning if we successfully resolved to at least a module name
if not (modrefs |> List.exists (fun (_, modref, _) -> modref.IsModule && not (EntityHasWellKnownAttribute g WellKnownEntityAttributes.RequireQualifiedAccessAttribute modref.Deref))) then
modrefs |> List.iter (fun (_, modref, _) ->
if IsPartiallyQualifiedNamespace modref then
- errorR(Error(FSComp.SR.tcOpenUsedWithPartiallyQualifiedPath(fullDisplayTextOfModRef modref), m)))
+ errorR(RichError(FSComp.SR.tcOpenUsedWithPartiallyQualifiedPath(richTextOfQualifiedModRef modref), m)))
let modrefs = List.map p23 modrefs
modrefs |> List.iter (fun modref -> CheckEntityAttributes g modref m |> CommitOperationResult)
@@ -790,7 +790,7 @@ let TcOpenTypeDecl (cenv: cenv) mOpenDecl scopem env (synType: SynType, m) =
let ty, _tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurrence.Open WarnOnIWSAM.Yes env emptyUnscopedTyparEnv synType
if not (isAppTy g ty) then
- errorR(Error(FSComp.SR.tcNamedTypeRequired("open type"), m))
+ errorR(RichError(FSComp.SR.tcNamedTypeRequired(RichText.mkKeyword "open type"), m))
if isByrefTy g ty then
errorR(Error(FSComp.SR.tcIllegalByrefsInOpenTypeDeclaration(), m))
@@ -841,12 +841,12 @@ module AddAugmentationDeclarations =
let hasExplicitIStructuralComparable = tycon.HasInterface g g.mk_IStructuralComparable_ty
if hasExplicitIComparable then
- errorR(Error(FSComp.SR.tcImplementsIComparableExplicitly(tycon.DisplayName), m))
+ errorR(RichError(FSComp.SR.tcImplementsIComparableExplicitly(richTextOfEntity tycon), m))
elif hasExplicitGenericIComparable then
- errorR(Error(FSComp.SR.tcImplementsGenericIComparableExplicitly(tycon.DisplayName), m))
+ errorR(RichError(FSComp.SR.tcImplementsGenericIComparableExplicitly(richTextOfEntity tycon), m))
elif hasExplicitIStructuralComparable then
- errorR(Error(FSComp.SR.tcImplementsIStructuralComparableExplicitly(tycon.DisplayName), m))
+ errorR(RichError(FSComp.SR.tcImplementsIStructuralComparableExplicitly(richTextOfEntity tycon), m))
else
let hasExplicitGenericIComparable = tycon.HasInterface g genericIComparableTy
let cvspec1, cvspec2 = AugmentTypeDefinitions.MakeValsForCompareAugmentation g tcref
@@ -872,7 +872,7 @@ module AddAugmentationDeclarations =
let hasExplicitIStructuralEquatable = tycon.HasInterface g g.mk_IStructuralEquatable_ty
if hasExplicitIStructuralEquatable then
- errorR(Error(FSComp.SR.tcImplementsIStructuralEquatableExplicitly(tycon.DisplayName), m))
+ errorR(RichError(FSComp.SR.tcImplementsIStructuralEquatableExplicitly(richTextOfEntity tycon), m))
else
let augmentation = AugmentTypeDefinitions.MakeValsForEqualityWithComparerAugmentation g tcref
PublishInterface cenv env.DisplayEnv tcref m true g.mk_IStructuralEquatable_ty
@@ -927,7 +927,7 @@ module AddAugmentationDeclarations =
let hasExplicitGenericIEquatable = tcaugHasNominalInterface g tcaug g.system_GenericIEquatable_tcref
if hasExplicitGenericIEquatable then
- errorR(Error(FSComp.SR.tcImplementsIEquatableExplicitly(tycon.DisplayName), m))
+ errorR(RichError(FSComp.SR.tcImplementsIEquatableExplicitly(richTextOfEntity tycon), m))
// Note: only provide the equals method if Equals is not implemented explicitly, and
// we're actually generating Hash/Equals for this type
@@ -1153,7 +1153,7 @@ module MutRecBindingChecking =
let allDo = letBinds |> List.forall (function SynBinding(kind=SynBindingKind.Do) -> true | _ -> false)
// Code for potential future design change to allow functions-compiled-as-members in structs
if allDo then
- errorR(Deprecated(FSComp.SR.tcStructsMayNotContainDoBindings(), (trimRangeToLine m)))
+ errorR(Deprecated(RichText.mkText (FSComp.SR.tcStructsMayNotContainDoBindings()), (trimRangeToLine m)))
else
// Code for potential future design change to allow functions-compiled-as-members in structs
errorR(Error(FSComp.SR.tcStructsMayNotContainLetBindings(), (trimRangeToLine m)))
@@ -1454,7 +1454,7 @@ module MutRecBindingChecking =
match TryFindIntrinsicMethInfo cenv.infoReader bind.Var.Range ad nm ty,
TryFindIntrinsicPropInfo cenv.infoReader bind.Var.Range ad nm ty with
| [], [] -> ()
- | _ -> errorR (Error(FSComp.SR.tcMemberAndLocalClassBindingHaveSameName nm, bind.Var.Range))
+ | _ -> errorR (RichError(FSComp.SR.tcMemberAndLocalClassBindingHaveSameName (RichText.mkMember nm), bind.Var.Range))
// Also add static entries to the envInstance if necessary
let envInstance = (if isStatic then (binds, envInstance) ||> List.foldBack (fun b e -> AddLocalVal g cenv.tcSink scopem b.Var e) else env)
@@ -1591,7 +1591,7 @@ module MutRecBindingChecking =
collectedBinds.Add pgbrind
yield pgbrind ])
- CheckRecursiveInlineGroup (List.ofSeq collectedBinds)
+ CheckRecursiveInlineGroup g (List.ofSeq collectedBinds)
result
@@ -1775,7 +1775,7 @@ module MutRecBindingChecking =
let modrefs = mvvs |> List.map p23
if not (isNil modrefs) && modrefs |> List.forall (fun modref -> modref.IsNamespace) then
- errorR(Error(FSComp.SR.tcModuleAbbreviationForNamespace(fullDisplayTextOfModRef (List.head modrefs)), m))
+ errorR(RichError(FSComp.SR.tcModuleAbbreviationForNamespace(richTextOfQualifiedModRef (List.head modrefs)), m))
let modrefs = modrefs |> List.filter (fun mvv -> not mvv.IsNamespace)
@@ -1927,7 +1927,7 @@ module MutRecBindingChecking =
for extraTypar in allExtraGeneralizableTypars do
if Zset.memberOf freeInInitialEnv extraTypar then
let ty = mkTyparTy extraTypar
- errorR(Error(FSComp.SR.tcNotSufficientlyGenericBecauseOfScope(NicePrint.prettyStringOfTy denv ty), extraTypar.Range))
+ errorR(RichError(FSComp.SR.tcNotSufficientlyGenericBecauseOfScope(NicePrint.prettyRichTextOfTy denv ty), extraTypar.Range))
// Solve any type variables in any part of the overall type signature of the class whose
// constraints involve generalized type variables.
@@ -2255,9 +2255,9 @@ module TyconConstraintInference =
failwith "unreachable"
| Some (ty, _) ->
if isTyparTy g ty then
- errorR(Error(FSComp.SR.tcStructuralComparisonNotSatisfied1(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty), tycon.Range))
+ errorR(RichError(FSComp.SR.tcStructuralComparisonNotSatisfied1(richTextOfEntity tycon, NicePrint.prettyRichTextOfTy denv ty), tycon.Range))
else
- errorR(Error(FSComp.SR.tcStructuralComparisonNotSatisfied2(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty), tycon.Range))
+ errorR(RichError(FSComp.SR.tcStructuralComparisonNotSatisfied2(richTextOfEntity tycon, NicePrint.prettyRichTextOfTy denv ty), tycon.Range))
else
match structuralTypes |> List.tryFind (fst >> checkIfFieldTypeSupportsComparison tycon >> not) with
| None ->
@@ -2268,9 +2268,9 @@ module TyconConstraintInference =
// PERF: this call to prettyStringOfTy is always being executed, even when the warning
// is not being reported (the normal case).
if isTyparTy g ty then
- warning(Error(FSComp.SR.tcNoComparisonNeeded1(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty, tycon.DisplayName), tycon.Range))
+ warning(RichError(FSComp.SR.tcNoComparisonNeeded1(richTextOfEntity tycon, NicePrint.prettyRichTextOfTy denv ty, richTextOfEntity tycon), tycon.Range))
else
- warning(Error(FSComp.SR.tcNoComparisonNeeded2(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty, tycon.DisplayName), tycon.Range))
+ warning(RichError(FSComp.SR.tcNoComparisonNeeded2(richTextOfEntity tycon, NicePrint.prettyRichTextOfTy denv ty, richTextOfEntity tycon), tycon.Range))
res)
@@ -2378,9 +2378,9 @@ module TyconConstraintInference =
failwith "unreachable"
| Some (ty, _) ->
if isTyparTy g ty then
- errorR(Error(FSComp.SR.tcStructuralEqualityNotSatisfied1(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty), tycon.Range))
+ errorR(RichError(FSComp.SR.tcStructuralEqualityNotSatisfied1(richTextOfEntity tycon, NicePrint.prettyRichTextOfTy denv ty), tycon.Range))
else
- errorR(Error(FSComp.SR.tcStructuralEqualityNotSatisfied2(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty), tycon.Range))
+ errorR(RichError(FSComp.SR.tcStructuralEqualityNotSatisfied2(richTextOfEntity tycon, NicePrint.prettyRichTextOfTy denv ty), tycon.Range))
else
if AugmentTypeDefinitions.TyconIsCandidateForAugmentationWithEquals g tycon then
match structuralTypes |> List.tryFind (fst >> checkIfFieldTypeSupportsEquality tycon >> not) with
@@ -2389,9 +2389,9 @@ module TyconConstraintInference =
failwith "unreachable"
| Some (ty, _) ->
if isTyparTy g ty then
- warning(Error(FSComp.SR.tcNoEqualityNeeded1(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty, tycon.DisplayName), tycon.Range))
+ warning(RichError(FSComp.SR.tcNoEqualityNeeded1(richTextOfEntity tycon, NicePrint.prettyRichTextOfTy denv ty, richTextOfEntity tycon), tycon.Range))
else
- warning(Error(FSComp.SR.tcNoEqualityNeeded2(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty, tycon.DisplayName), tycon.Range))
+ warning(RichError(FSComp.SR.tcNoEqualityNeeded2(richTextOfEntity tycon, NicePrint.prettyRichTextOfTy denv ty, richTextOfEntity tycon), tycon.Range))
res)
@@ -3141,7 +3141,7 @@ module EstablishTypeDefinitionCores =
if not isRootGenerated then
let desig = theRootTypeWithRemapping.TypeProviderDesignation
let nm = theRootTypeWithRemapping.PUntaint((fun st -> string st.FullName), m)
- error(Error(FSComp.SR.etErasedTypeUsedInGeneration(desig, nm), m))
+ error(RichError(FSComp.SR.etErasedTypeUsedInGeneration(RichText.mkText desig, RichText.mkUnknownType nm), m))
cenv.createsGeneratedProvidedTypes <- true
@@ -3182,7 +3182,7 @@ module EstablishTypeDefinitionCores =
if not isGenerated then
let desig = st.TypeProviderDesignation
let nm = st.PUntaint((fun st -> string st.FullName), m)
- error(Error(FSComp.SR.etErasedTypeUsedInGeneration(desig, nm), m))
+ error(RichError(FSComp.SR.etErasedTypeUsedInGeneration(RichText.mkText desig, RichText.mkUnknownType nm), m))
// Embed the type into the module we're compiling
let cpath = eref.CompilationPath.NestedCompPath eref.LogicalName ModuleOrNamespaceKind.ModuleOrType
@@ -3324,7 +3324,7 @@ module EstablishTypeDefinitionCores =
| CompiledTypeRepr.ILAsmOpen _ -> ()
| CompiledTypeRepr.ILAsmNamed _ ->
if tcref.CompiledRepresentationForNamedType.FullName = fullName then
- warning(Error(FSComp.SR.chkAttributeAliased(fullName), tycon.Id.idRange))
+ warning(RichError(FSComp.SR.chkAttributeAliased(richTextOfEntityRefName tcref fullName), tycon.Id.idRange))
| _ -> ()
// Check for attributes in unit-of-measure declarations
@@ -3341,7 +3341,7 @@ module EstablishTypeDefinitionCores =
let ftyvs = freeInTypeLeftToRight g false ty
let typars = tycon.Typars
if ftyvs.Length <> typars.Length then
- errorR(Deprecated(FSComp.SR.tcTypeAbbreviationHasTypeParametersMissingOnType(), tycon.Range))
+ errorR(Deprecated(RichText.mkText (FSComp.SR.tcTypeAbbreviationHasTypeParametersMissingOnType()), tycon.Range))
if firstPass then
tycon.SetTypeAbbrev (Some ty)
@@ -4348,7 +4348,7 @@ module TcDeclarations =
| Exception exn ->
if inSig && List.isSingleton longPath then
- errorR(Deprecated(FSComp.SR.tcReservedSyntaxForAugmentation(), m))
+ errorR(Deprecated(RichText.mkText (FSComp.SR.tcReservedSyntaxForAugmentation()), m))
ForceRaise (Exception exn)
tcref
@@ -4396,18 +4396,18 @@ module TcDeclarations =
elif isInSameModuleOrNamespace && not isInterfaceOrDelegateOrEnum then
// For historical reasons we only give a warning for incorrect type parameters on intrinsic extensions
if nReqTypars <> synTypars.Length then
- errorR(Error(FSComp.SR.tcDeclaredTypeParametersForExtensionDoNotMatchOriginal(tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m))
+ errorR(RichError(FSComp.SR.tcDeclaredTypeParametersForExtensionDoNotMatchOriginal(richTextOfEntityRefName tcref tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m))
if not (checkTyparsForExtension()) then
- warning(Error(FSComp.SR.tcDeclaredTypeParametersForExtensionDoNotMatchOriginal(tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m))
+ warning(RichError(FSComp.SR.tcDeclaredTypeParametersForExtensionDoNotMatchOriginal(richTextOfEntityRefName tcref tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m))
// Note we return 'reqTypars' for intrinsic extensions since we may only have given warnings
IntrinsicExtensionBinding, tcref, reqTypars
else
if isInSameModuleOrNamespace && isDelegateOrEnum then
errorR(Error(FSComp.SR.tcMembersThatExtendInterfaceMustBePlacedInSeparateModule(), tcref.Range))
if nReqTypars <> synTypars.Length then
- error(Error(FSComp.SR.tcDeclaredTypeParametersForExtensionDoNotMatchOriginal(tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m))
+ error(RichError(FSComp.SR.tcDeclaredTypeParametersForExtensionDoNotMatchOriginal(richTextOfEntityRefName tcref tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m))
if not (checkTyparsForExtension()) then
- errorR(Error(FSComp.SR.tcDeclaredTypeParametersForExtensionDoNotMatchOriginal(tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m))
+ errorR(RichError(FSComp.SR.tcDeclaredTypeParametersForExtensionDoNotMatchOriginal(richTextOfEntityRefName tcref tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m))
ExtrinsicExtensionBinding, tcref, declaredTypars
@@ -5074,7 +5074,7 @@ let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcE
let modrefs = unfilteredModrefs |> List.filter (fun modref -> not modref.IsNamespace)
if not (List.isEmpty unfilteredModrefs) && List.isEmpty modrefs then
- errorR(Error(FSComp.SR.tcModuleAbbreviationForNamespace(fullDisplayTextOfModRef (List.head unfilteredModrefs)), m))
+ errorR(RichError(FSComp.SR.tcModuleAbbreviationForNamespace(richTextOfQualifiedModRef (List.head unfilteredModrefs)), m))
if List.isEmpty modrefs then return env else
modrefs |> List.iter (fun modref -> CheckEntityAttributes g modref m |> CommitOperationResult)
@@ -5257,7 +5257,7 @@ let TcMutRecDefnsEscapeCheck (binds: MutRecShapes<_, _, _>) env =
let checkTycon (tycon: Tycon) =
if not tycon.IsTypeAbbrev && Zset.contains tycon freeInEnv then
let nm = tycon.DisplayName
- errorR(Error(FSComp.SR.tcTypeUsedInInvalidWay(nm, nm, nm), tycon.Range))
+ errorR(RichError(FSComp.SR.tcTypeUsedInInvalidWay(richTextOfEntityName tycon nm, richTextOfEntityName tycon nm, richTextOfEntityName tycon nm), tycon.Range))
binds |> MutRecShapes.iterTycons (fst >> Option.iter checkTycon)
@@ -5266,7 +5266,7 @@ let TcMutRecDefnsEscapeCheck (binds: MutRecShapes<_, _, _>) env =
for bind in binds do
if Zset.contains bind.Var freeInEnv then
let nm = bind.Var.DisplayName
- errorR(Error(FSComp.SR.tcMemberUsedInInvalidWay(nm, nm, nm), bind.Var.Range))
+ errorR(RichError(FSComp.SR.tcMemberUsedInInvalidWay(RichText.mkMember nm, RichText.mkMember nm, RichText.mkMember nm), bind.Var.Range))
binds |> MutRecShapes.iterTyconsAndLets (snd >> checkBinds) checkBinds
@@ -5697,7 +5697,7 @@ and TcModuleOrNamespaceElements cenv parent endm env xml mutRecNSInfo openDecls0
let ApplyAssemblyLevelAutoOpenAttributeToTcEnv g amap (ccu: CcuThunk) scopem env (p, root) =
let warn() =
- warning(Error(FSComp.SR.tcAttributeAutoOpenWasIgnored(p, ccu.AssemblyName), scopem))
+ warning(RichError(FSComp.SR.tcAttributeAutoOpenWasIgnored(RichText.mkModule p, RichText.mkText ccu.AssemblyName), scopem))
[], env
let p = splitNamespace p
match List.tryFrontAndBack p with
@@ -6029,7 +6029,7 @@ let CheckOneImplFile
match attrName with
| "System.Reflection.AssemblyFileVersionAttribute" //TODO compile error like c# compiler?
| "System.Reflection.AssemblyVersionAttribute" when not (isValid()) ->
- warning(Error(FSComp.SR.fscBadAssemblyVersion(attrName, version), range))
+ warning(RichError(FSComp.SR.fscBadAssemblyVersion(RichText.mkClass attrName, RichText.mkText version), range))
| _ -> ()
| _ -> ())
diff --git a/src/Compiler/Checking/CheckFormatStrings.fs b/src/Compiler/Checking/CheckFormatStrings.fs
index 70608224578..81afa741079 100644
--- a/src/Compiler/Checking/CheckFormatStrings.fs
+++ b/src/Compiler/Checking/CheckFormatStrings.fs
@@ -459,8 +459,7 @@ let parseFormatStringInternal
// residue of hole "...{n}..." in interpolated strings become %P(...)
| 'P' when isInterpolated ->
- let code, message = FSComp.SR.alwaysUseTypedStringInterpolation()
- warning(DiagnosticWithText(code, message, m))
+ warning(Error(FSComp.SR.alwaysUseTypedStringInterpolation(), m))
checkOtherFlags ch
let i = requireAndSkipInterpolationHoleFormat (i+1)
// Note, the fragCol doesn't advance at all as these are magically inserted.
@@ -498,7 +497,7 @@ let parseFormatStringInternal
| '%' ->
// This allows for things like `printf "%-4.2%"` to compile and print just a `%`
// For now we are adding a warning, but keeping this behavior.
- warning(DiagnosticWithText(3376, FSComp.SR.forBadFormatSpecifierGeneral("%"), m))
+ warning(Error((3376, FSComp.SR.forBadFormatSpecifierGeneral("%")), m))
collectSpecifierLocation fragLine fragCol 0
appendToDotnetFormatString "%"
parseLoop acc (i+1, fragLine, fragCol+1) fragments
diff --git a/src/Compiler/Checking/CheckIncrementalClasses.fs b/src/Compiler/Checking/CheckIncrementalClasses.fs
index 3bc3af174d1..4e831f1eecb 100644
--- a/src/Compiler/Checking/CheckIncrementalClasses.fs
+++ b/src/Compiler/Checking/CheckIncrementalClasses.fs
@@ -335,7 +335,7 @@ type IncrClassReprInfo =
let reportIfUnused() =
if not v.HasBeenReferenced && not (v.DisplayName.StartsWithOrdinal("_")) && not v.IsCompilerGenerated then
- warning (Error(FSComp.SR.chkUnusedValue(v.DisplayName), v.Range))
+ warning (RichError(FSComp.SR.chkUnusedValue(richTextOfValName cenv.g v), v.Range))
let repr =
match InferValReprInfoOfBinding g AllowTypeDirectedDetupling.Yes v bind.Expr with
diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs
index 55295562303..bb33a1c5015 100644
--- a/src/Compiler/Checking/CheckPatterns.fs
+++ b/src/Compiler/Checking/CheckPatterns.fs
@@ -22,6 +22,7 @@ open FSharp.Compiler.Syntax
open FSharp.Compiler.Syntax.PrettyNaming
open FSharp.Compiler.SyntaxTreeOps
open FSharp.Compiler.TcGlobals
+open FSharp.Compiler.Text
open FSharp.Compiler.Text.Range
open FSharp.Compiler.TypedTree
open FSharp.Compiler.TypedTreeBasics
@@ -245,10 +246,10 @@ and TcPatBindingName cenv env id ty isMemberThis vis1 valReprInfo (vFlags: TcPat
if not (String.IsNullOrEmpty name) && not (String.isLeadingIdentifierCharacterUpperCase name) then
match env.eNameResEnv.ePatItems.TryGetValue name with
| true, Item.Value vref when vref.LiteralValue.IsSome ->
- warning(Error(FSComp.SR.checkLowercaseLiteralBindingInPattern name, id.idRange))
+ warning(RichError(FSComp.SR.checkLowercaseLiteralBindingInPattern (RichText.mkLocal name), id.idRange))
| _ -> ()
value
- | _ -> error(Error(FSComp.SR.tcNameNotBoundInPattern name, id.idRange))
+ | _ -> error(RichError(FSComp.SR.tcNameNotBoundInPattern (RichText.mkUnresolvedName name), id.idRange))
// isLeftMost indicates we are processing the left-most path through a disjunctive or pattern.
// For those binding locations, CallNameResolutionSink is called in MakeAndPublishValue, like all other bindings
@@ -592,7 +593,7 @@ and TcPatLongIdent warnOnUpper cenv env ad valReprInfo vFlags (patEnv: TcPatLine
match args with
| SynArgPats.Pats _ -> ()
- | _ -> errorR (Error (FSComp.SR.tcNamedActivePattern apinfo.ActiveTags[idx], m))
+ | _ -> errorR (RichError(FSComp.SR.tcNamedActivePattern (RichText.mkActivePatternCase apinfo.ActiveTags[idx]), m))
let args = GetSynArgPatterns args
@@ -648,7 +649,7 @@ and ApplyUnionCaseOrExn m (cenv: cenv) env overallTy item =
| Item.UnionCase(ucinfo, showDeprecated) ->
if showDeprecated then
- let diagnostic = Deprecated(FSComp.SR.nrUnionTypeNeedsQualifiedAccess(ucinfo.DisplayName, ucinfo.Tycon.DisplayName) |> snd, m)
+ let diagnostic = Deprecated(FSComp.SR.nrUnionTypeNeedsQualifiedAccess(RichText.mkUnionCase ucinfo.DisplayName, richTextOfEntity ucinfo.Tycon) |> snd, m)
if g.langVersion.SupportsFeature(LanguageFeature.ErrorOnDeprecatedRequireQualifiedAccess) then
errorR(diagnostic)
else
@@ -717,11 +718,11 @@ and TcPatLongIdentUnionCaseOrExnCase warnOnUpper cenv env ad vFlags patEnv ty (m
extraPatterns.Add pat
match item with
| Item.UnionCase(uci, _) ->
- errorR (Error (FSComp.SR.tcUnionCaseConstructorDoesNotHaveFieldWithGivenName (uci.DisplayName, id.idText), id.idRange))
+ errorR (RichError(FSComp.SR.tcUnionCaseConstructorDoesNotHaveFieldWithGivenName (RichText.mkUnionCase uci.DisplayName, RichText.mkUnresolvedName id.idText), id.idRange))
| Item.ExnCase tcref ->
- errorR (Error (FSComp.SR.tcExceptionConstructorDoesNotHaveFieldWithGivenName (tcref.DisplayName, id.idText), id.idRange))
+ errorR (RichError(FSComp.SR.tcExceptionConstructorDoesNotHaveFieldWithGivenName (richTextOfEntityRef tcref, RichText.mkUnresolvedName id.idText), id.idRange))
| _ ->
- errorR (Error (FSComp.SR.tcConstructorDoesNotHaveFieldWithGivenName id.idText, id.idRange))
+ errorR (RichError(FSComp.SR.tcConstructorDoesNotHaveFieldWithGivenName (RichText.mkUnresolvedName id.idText), id.idRange))
| Some idx ->
let argItem =
@@ -736,7 +737,7 @@ and TcPatLongIdentUnionCaseOrExnCase warnOnUpper cenv env ad vFlags patEnv ty (m
| null -> result[idx] <- pat
| _ ->
extraPatterns.Add pat
- errorR (Error (FSComp.SR.tcUnionCaseFieldCannotBeUsedMoreThanOnce id.idText, id.idRange))
+ errorR (RichError(FSComp.SR.tcUnionCaseFieldCannotBeUsedMoreThanOnce (RichText.mkField id.idText), id.idRange))
for i = 0 to numArgTys - 1 do
if isNull (box result[i]) then
@@ -778,14 +779,19 @@ and TcPatLongIdentUnionCaseOrExnCase warnOnUpper cenv env ad vFlags patEnv ty (m
elif numArgs < numArgTys then
if numArgTys > 1 then
// Expects tuple without enough args
- let printTy = NicePrint.minimalStringOfType env.DisplayEnv
let missingArgs =
argNames.[numArgs..numArgTys - 1]
- |> List.map (fun id -> (if id.rfield_name_generated then "" else id.DisplayName + ": ") + printTy id.FormalType)
- |> String.concat (Environment.NewLine + "\t")
- |> fun s -> Environment.NewLine + "\t" + s
-
- errorR (Error (FSComp.SR.tcUnionCaseExpectsTupledArguments(numArgTys, numArgs, missingArgs), m))
+ |> List.map (fun id ->
+ RichText.concat
+ [ if not id.rfield_name_generated then
+ RichText.mkRecordField id.DisplayName
+ RichText.mkPunctuation ":"
+ RichText.mkText " "
+ NicePrint.minimalRichTextOfType env.DisplayEnv id.FormalType ])
+ |> RichText.concatWith (RichText.mkText (Environment.NewLine + "\t"))
+ |> RichText.append (RichText.mkText (Environment.NewLine + "\t"))
+
+ errorR (RichError (FSComp.SR.tcUnionCaseExpectsTupledArguments(numArgTys, numArgs, missingArgs), m))
else
errorR (UnionCaseWrongArguments (env.DisplayEnv, numArgTys, numArgs, m))
args @ (List.init (numArgTys - numArgs) (fun _ -> SynPat.Wild (m.MakeSynthetic()))), extraPatterns
@@ -807,7 +813,7 @@ and TcPatLongIdentILField warnOnUpper (cenv: cenv) env vFlags patEnv ty (mLongId
CheckILFieldInfoAccessible g cenv.amap mLongId env.AccessRights finfo
if not finfo.IsStatic then
- errorR (Error (FSComp.SR.tcFieldIsNotStatic finfo.FieldName, mLongId))
+ errorR (RichError(FSComp.SR.tcFieldIsNotStatic (RichText.mkField finfo.FieldName), mLongId))
CheckILFieldAttributes g finfo m
@@ -828,7 +834,7 @@ and TcPatLongIdentILField warnOnUpper (cenv: cenv) env vFlags patEnv ty (mLongId
and TcPatLongIdentRecdField warnOnUpper cenv env vFlags patEnv ty (mLongId, rfinfo, args, m) =
let g = cenv.g
CheckRecdFieldInfoAccessible cenv.amap mLongId env.AccessRights rfinfo
- if not rfinfo.IsStatic then errorR (Error (FSComp.SR.tcFieldIsNotStatic(rfinfo.DisplayName), mLongId))
+ if not rfinfo.IsStatic then errorR (RichError(FSComp.SR.tcFieldIsNotStatic(RichText.mkRecordField rfinfo.DisplayName), mLongId))
CheckRecdFieldInfoAttributes g rfinfo mLongId |> CommitOperationResult
match rfinfo.LiteralValue with
@@ -853,7 +859,7 @@ and TcPatLongIdentLiteral warnOnUpper (cenv: cenv) env vFlags patEnv ty (mLongId
| None -> error (Error(FSComp.SR.tcNonLiteralCannotBeUsedInPattern(), m))
| Some lit ->
let _, _, _, vexpty, _, _ = TcVal cenv env tpenv vref None None mLongId
- CheckValAccessible mLongId env.AccessRights vref
+ CheckValAccessible g mLongId env.AccessRights vref
CheckFSharpAttributes g vref.Attribs mLongId |> CommitOperationResult
CheckNoArgsForLiteral args m
let _, acc = TcArgPats warnOnUpper cenv env vFlags patEnv args
diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs
index ca4fe23ae79..a74035b04c9 100644
--- a/src/Compiler/Checking/ConstraintSolver.fs
+++ b/src/Compiler/Checking/ConstraintSolver.fs
@@ -245,11 +245,11 @@ exception ConstraintSolverNullnessWarningWithTypes of DisplayEnv * TType * TType
exception ConstraintSolverNullnessWarningWithType of DisplayEnv * TType * NullnessInfo * range * range
-exception ConstraintSolverNullnessWarning of string * range * range
+exception ConstraintSolverNullnessWarning of RichText * range * range
exception ConstraintSolverNullnessWarningOnDotAccess of DisplayEnv * objTy: TType * memberName: string * bindingName: string option * objExprRange: range * mMethod: range
-exception ConstraintSolverError of string * range * range
+exception ConstraintSolverError of RichText * range * range
exception ErrorFromApplyingDefault of tcGlobals: TcGlobals * displayEnv: DisplayEnv * Typar * TType * error: exn * range: range
@@ -696,7 +696,7 @@ let rec TransactStaticReq (csenv: ConstraintSolverEnv) (trace: OptionalTrace) (t
// declared StaticReq. With feature InterfacesWithAbstractStaticMembers it is inferred
// from the finalized constraints on the type variable.
if not (g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers) && tpr.Rigidity.ErrorIfUnified && tpr.StaticReq <> req then
- ErrorD(ConstraintSolverError(FSComp.SR.csTypeCannotBeResolvedAtCompileTime(tpr.Name), m, m))
+ ErrorD(ConstraintSolverError(RichText.mkText (FSComp.SR.csTypeCannotBeResolvedAtCompileTime(tpr.Name)), m, m))
else
let orig = tpr.StaticReq
trace.Exec (fun () -> tpr.SetStaticReq req) (fun () -> tpr.SetStaticReq orig)
@@ -1183,11 +1183,11 @@ and SolveTyparsEqualTypes (csenv: ConstraintSolverEnv) ndeep m2 (trace: Optional
and SolveAnonInfoEqualsAnonInfo (csenv: ConstraintSolverEnv) m2 (anonInfo1: AnonRecdTypeInfo) (anonInfo2: AnonRecdTypeInfo) =
if evalTupInfoIsStruct anonInfo1.TupInfo <> evalTupInfoIsStruct anonInfo2.TupInfo then
- ErrorD (ConstraintSolverError(FSComp.SR.tcTupleStructMismatch(), csenv.m,m2))
+ ErrorD (ConstraintSolverError(RichText.mkText (FSComp.SR.tcTupleStructMismatch()), csenv.m,m2))
else
trackErrors {
if not (ccuEq anonInfo1.Assembly anonInfo2.Assembly) then
- do! ErrorD (ConstraintSolverError(FSComp.SR.tcAnonRecdCcuMismatch(anonInfo1.Assembly.AssemblyName, anonInfo2.Assembly.AssemblyName), csenv.m,m2))
+ do! ErrorD (ConstraintSolverError(RichText.mkText (FSComp.SR.tcAnonRecdCcuMismatch(anonInfo1.Assembly.AssemblyName, anonInfo2.Assembly.AssemblyName)), csenv.m,m2))
if anonInfo1.SortedNames <> anonInfo2.SortedNames then
let (|Subset|Superset|Overlap|CompletelyDifferent|) (first, second) =
@@ -1207,46 +1207,42 @@ and SolveAnonInfoEqualsAnonInfo (csenv: ConstraintSolverEnv) m2 (anonInfo1: Anon
let second = Set.toList second
CompletelyDifferent(first, second)
+ let quotedNames names =
+ names
+ |> List.map (fun name ->
+ RichText.concat
+ [ RichText.mkPunctuation "'"
+ RichText.mkRecordField name
+ RichText.mkPunctuation "'" ])
+ |> RichText.concatWith (RichText.mkText ", ")
+
let message =
match anonInfo1.SortedNames, anonInfo2.SortedNames with
| Subset missingFields ->
match missingFields with
| [missingField] ->
- FSComp.SR.tcAnonRecdSingleFieldNameSubset(string missingField)
+ FSComp.SR.tcAnonRecdSingleFieldNameSubset(RichText.mkRecordField missingField)
| _ ->
- let missingFields = missingFields |> List.map(sprintf "'%s'")
- let missingFields = String.concat ", " missingFields
- FSComp.SR.tcAnonRecdMultipleFieldsNameSubset(string missingFields)
+ FSComp.SR.tcAnonRecdMultipleFieldsNameSubset(quotedNames missingFields)
| Superset extraFields ->
match extraFields with
| [extraField] ->
- FSComp.SR.tcAnonRecdSingleFieldNameSuperset(string extraField)
+ FSComp.SR.tcAnonRecdSingleFieldNameSuperset(RichText.mkRecordField extraField)
| _ ->
- let extraFields = extraFields |> List.map(sprintf "'%s'")
- let extraFields = String.concat ", " extraFields
- FSComp.SR.tcAnonRecdMultipleFieldsNameSuperset(string extraFields)
+ FSComp.SR.tcAnonRecdMultipleFieldsNameSuperset(quotedNames extraFields)
| Overlap (missingFields, extraFields) ->
- FSComp.SR.tcAnonRecdFieldNameMismatch(string missingFields, string extraFields)
+ FSComp.SR.tcAnonRecdFieldNameMismatch(RichText.mkText (string missingFields), RichText.mkText (string extraFields))
| CompletelyDifferent missingFields ->
let missingFields, usedFields = missingFields
match missingFields, usedFields with
| [ missingField ], [ usedField ] ->
- FSComp.SR.tcAnonRecdSingleFieldNameSingleDifferent(missingField, usedField)
+ FSComp.SR.tcAnonRecdSingleFieldNameSingleDifferent(RichText.mkRecordField missingField, RichText.mkRecordField usedField)
| [ missingField ], usedFields ->
- let usedFields = usedFields |> List.map(sprintf "'%s'")
- let usedFields = String.concat ", " usedFields
- FSComp.SR.tcAnonRecdSingleFieldNameMultipleDifferent(missingField, usedFields)
+ FSComp.SR.tcAnonRecdSingleFieldNameMultipleDifferent(RichText.mkRecordField missingField, quotedNames usedFields)
| missingFields, [ usedField ] ->
- let missingFields = missingFields |> List.map(sprintf "'%s'")
- let missingFields = String.concat ", " missingFields
- FSComp.SR.tcAnonRecdMultipleFieldNameSingleDifferent(missingFields, usedField)
-
+ FSComp.SR.tcAnonRecdMultipleFieldNameSingleDifferent(quotedNames missingFields, RichText.mkRecordField usedField)
| missingFields, usedFields ->
- let missingFields = missingFields |> List.map(sprintf "'%s'")
- let missingFields = String.concat ", " missingFields
- let usedFields = usedFields |> List.map(sprintf "'%s'")
- let usedFields = String.concat ", " usedFields
- FSComp.SR.tcAnonRecdMultipleFieldNameMultipleDifferent(missingFields, usedFields)
+ FSComp.SR.tcAnonRecdMultipleFieldNameMultipleDifferent(quotedNames missingFields, quotedNames usedFields)
do! ErrorD (ConstraintSolverError(message, csenv.m,m2))
else
@@ -1398,7 +1394,7 @@ and SolveTypeEqualsType (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr
| TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2) ->
if evalTupInfoIsStruct tupInfo1 <> evalTupInfoIsStruct tupInfo2 then
- ErrorD (ConstraintSolverError(FSComp.SR.tcTupleStructMismatch(), csenv.m, m2))
+ ErrorD (ConstraintSolverError(RichText.mkText (FSComp.SR.tcTupleStructMismatch()), csenv.m, m2))
else
SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2
@@ -1566,7 +1562,7 @@ and SolveTypeSubsumesType (csenv: ConstraintSolverEnv) ndeep m2 (trace: Optional
| TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2) ->
if evalTupInfoIsStruct tupInfo1 <> evalTupInfoIsStruct tupInfo2 then
- ErrorD (ConstraintSolverError(FSComp.SR.tcTupleStructMismatch(), csenv.m, m2))
+ ErrorD (ConstraintSolverError(RichText.mkText (FSComp.SR.tcTupleStructMismatch()), csenv.m, m2))
else
SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln l1 l2 (* nb. can unify since no variance *)
| TType_fun (domainTy1, rangeTy1, nullness1), TType_fun (domainTy2, rangeTy2, nullness2) ->
@@ -1739,7 +1735,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
if memFlags.IsInstance then
match supportTys, traitObjAndArgTys with
| [ty], h :: _ -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace h ty
- | _ -> do! ErrorD (ConstraintSolverError(FSComp.SR.csExpectedArguments(), m, m2))
+ | _ -> do! ErrorD (ConstraintSolverError(RichText.mkText (FSComp.SR.csExpectedArguments()), m, m2))
// Trait calls are only supported on pseudo type (variables)
if not (g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers) then
@@ -1874,7 +1870,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
when isArrayTy g ty ->
if rankOfArrayTy g ty <> argTys.Length then
- do! ErrorD(ConstraintSolverError(FSComp.SR.csIndexArgumentMismatch((rankOfArrayTy g ty), argTys.Length), m, m2))
+ do! ErrorD(ConstraintSolverError(RichText.mkText (FSComp.SR.csIndexArgumentMismatch((rankOfArrayTy g ty), argTys.Length)), m, m2))
for argTy in argTys do
do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy g.int_ty
@@ -1887,7 +1883,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
when isArrayTy g ty ->
if rankOfArrayTy g ty <> argTys.Length - 1 then
- do! ErrorD(ConstraintSolverError(FSComp.SR.csIndexArgumentMismatch((rankOfArrayTy g ty), (argTys.Length - 1)), m, m2))
+ do! ErrorD(ConstraintSolverError(RichText.mkText (FSComp.SR.csIndexArgumentMismatch((rankOfArrayTy g ty), (argTys.Length - 1))), m, m2))
let argTys, lastTy = List.frontAndBack argTys
for argTy in argTys do
@@ -2052,40 +2048,43 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
match minfos, recdPropSearch, anonRecdPropSearch with
| [], None, None when MemberConstraintIsReadyForStrongResolution csenv traitInfo ->
if supportTys |> List.exists (isFunTy g) then
- return! ErrorD (ConstraintSolverError(FSComp.SR.csExpectTypeWithOperatorButGivenFunction(ConvertValLogicalNameToDisplayNameCore nm), m, m2))
+ return! ErrorD (ConstraintSolverError(RichText.mkText (FSComp.SR.csExpectTypeWithOperatorButGivenFunction(ConvertValLogicalNameToDisplayNameCore nm)), m, m2))
elif supportTys |> List.exists (isAnyTupleTy g) then
- return! ErrorD (ConstraintSolverError(FSComp.SR.csExpectTypeWithOperatorButGivenTuple(ConvertValLogicalNameToDisplayNameCore nm), m, m2))
+ return! ErrorD (ConstraintSolverError(RichText.mkText (FSComp.SR.csExpectTypeWithOperatorButGivenTuple(ConvertValLogicalNameToDisplayNameCore nm)), m, m2))
else
match nm, argTys with
| "op_Explicit", [argTy] ->
- let argTyString = NicePrint.prettyStringOfTy denv argTy
- let rtyString = NicePrint.prettyStringOfTy denv retTy
- return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportConversion(argTyString, rtyString), m, m2))
+ let argTyText = NicePrint.prettyRichTextOfTy denv argTy
+ let retTyText = NicePrint.prettyRichTextOfTy denv retTy
+ return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportConversion(argTyText, retTyText), m, m2))
| _ ->
let tyString =
match supportTys with
- | [ty] -> NicePrint.minimalStringOfType denv ty
- | _ -> supportTys |> List.map (NicePrint.minimalStringOfType denv) |> String.concat ", "
+ | [ty] -> NicePrint.minimalRichTextOfType denv ty
+ | _ ->
+ supportTys
+ |> List.map (NicePrint.minimalRichTextOfType denv)
+ |> RichText.concatWith (RichText.mkText ", ")
let opName = ConvertValLogicalNameToDisplayNameCore nm
let err =
match opName with
| "?>=" | "?>" | "?<=" | "?<" | "?=" | "?<>"
| ">=?" | ">?" | "<=?" | "?"
| "?>=?" | "?>?" | "?<=?" | "??" ->
- if List.isSingleton supportTys then FSComp.SR.csTypeDoesNotSupportOperatorNullable(tyString, opName)
- else FSComp.SR.csTypesDoNotSupportOperatorNullable(tyString, opName)
+ if List.isSingleton supportTys then FSComp.SR.csTypeDoesNotSupportOperatorNullable(tyString, RichText.mkOperator opName)
+ else FSComp.SR.csTypesDoNotSupportOperatorNullable(tyString, RichText.mkOperator opName)
| _ ->
match supportTys, source.Value with
| [_], Some s when s.StartsWith("Operators.") ->
let opSource = s[10..]
- if opSource = nm then FSComp.SR.csTypeDoesNotSupportOperator(tyString, opName)
- else FSComp.SR.csTypeDoesNotSupportOperator(tyString, opSource)
+ if opSource = nm then FSComp.SR.csTypeDoesNotSupportOperator(tyString, RichText.mkOperator opName)
+ else FSComp.SR.csTypeDoesNotSupportOperator(tyString, RichText.mkOperator opSource)
| [_], Some s ->
- FSComp.SR.csFunctionDoesNotSupportType(s, tyString, nm)
+ FSComp.SR.csFunctionDoesNotSupportType(RichText.mkFunction s, tyString, RichText.mkFunction nm)
| [_], _
- -> FSComp.SR.csTypeDoesNotSupportOperator(tyString, opName)
+ -> FSComp.SR.csTypeDoesNotSupportOperator(tyString, RichText.mkOperator opName)
| _, _
- -> FSComp.SR.csTypesDoNotSupportOperator(tyString, opName)
+ -> FSComp.SR.csTypesDoNotSupportOperator(tyString, RichText.mkOperator opName)
return! ErrorD(ConstraintSolverError(err, m, m2))
| _ ->
@@ -2133,9 +2132,9 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload
if isInstance <> memFlags.IsInstance then
return!
if isInstance then
- ErrorD(ConstraintSolverError(FSComp.SR.csMethodFoundButIsNotStatic((NicePrint.minimalStringOfType denv minfo.ApparentEnclosingType), (ConvertValLogicalNameToDisplayNameCore nm), nm), m, m2 ))
+ ErrorD(ConstraintSolverError(FSComp.SR.csMethodFoundButIsNotStatic(NicePrint.minimalRichTextOfType denv minfo.ApparentEnclosingType, RichText.mkMethod (ConvertValLogicalNameToDisplayNameCore nm), RichText.mkMethod nm), m, m2 ))
else
- ErrorD(ConstraintSolverError(FSComp.SR.csMethodFoundButIsStatic((NicePrint.minimalStringOfType denv minfo.ApparentEnclosingType), (ConvertValLogicalNameToDisplayNameCore nm), nm), m, m2 ))
+ ErrorD(ConstraintSolverError(FSComp.SR.csMethodFoundButIsStatic(NicePrint.minimalRichTextOfType denv minfo.ApparentEnclosingType, RichText.mkMethod (ConvertValLogicalNameToDisplayNameCore nm), RichText.mkMethod nm), m, m2 ))
else
do! CheckMethInfoAttributes g m None minfo
return TTraitSolved (minfo, calledMeth.CalledTyArgs, calledMeth.OptionalStaticType)
@@ -2710,7 +2709,7 @@ and SolveTypeUseSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
if TypeNullIsExtraValueNew g m ty then
()
elif isNullableTy g ty then
- return! ErrorD (ConstraintSolverError(FSComp.SR.csNullableTypeDoesNotHaveNull(NicePrint.minimalStringOfType denv ty), m, m2))
+ return! ErrorD (ConstraintSolverError(FSComp.SR.csNullableTypeDoesNotHaveNull(NicePrint.minimalRichTextOfType denv ty), m, m2))
else
match tryDestTyparTy g ty with
| ValueSome tp ->
@@ -2732,7 +2731,7 @@ and SolveTypeUseSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
// If checkNullness is off give the same errors as F# 4.5
if not g.checkNullness && not (TypeNullIsExtraValue g m ty) then
- return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotHaveNull(NicePrint.minimalStringOfType denv ty), m, m2))
+ return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotHaveNull(NicePrint.minimalRichTextOfType denv ty), m, m2))
else
// Use legacy F# nullness rules when langFeatureNullness is disabled
do! SolveLegacyTypeUseSupportsNullLiteral csenv ndeep m2 trace ty
@@ -2747,13 +2746,13 @@ and SolveLegacyTypeUseSupportsNullLiteral (csenv: ConstraintSolverEnv) ndeep m2
if TypeNullIsExtraValue g m ty then
()
elif isNullableTy g ty then
- return! ErrorD (ConstraintSolverError(FSComp.SR.csNullableTypeDoesNotHaveNull(NicePrint.minimalStringOfType denv ty), m, m2))
+ return! ErrorD (ConstraintSolverError(FSComp.SR.csNullableTypeDoesNotHaveNull(NicePrint.minimalRichTextOfType denv ty), m, m2))
else
match tryDestTyparTy g ty with
| ValueSome tp ->
do! AddConstraint csenv ndeep m2 trace tp (TyparConstraint.SupportsNull m)
| ValueNone ->
- return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotHaveNull(NicePrint.minimalStringOfType denv ty), m, m2))
+ return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotHaveNull(NicePrint.minimalRichTextOfType denv ty), m, m2))
}
and SolveNullnessSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTrace) ty nullness =
@@ -2781,7 +2780,7 @@ and SolveNullnessSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 (trace: Opti
if (TypeNullIsExtraValue g m ty) then
return! WarnD(ConstraintSolverNullnessWarningWithType(denv, ty, n1, getNullnessWarningRange csenv, m2))
else
- return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotHaveNull(NicePrint.minimalStringOfType denv ty), m, m2))
+ return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotHaveNull(NicePrint.minimalRichTextOfType denv ty), m, m2))
| Nullness.KnownFromConstructor -> () // Unreachable after Normalize()
}
@@ -2794,7 +2793,7 @@ and SolveTypeUseNotSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
if TypeNullIsTrueValue g ty then
// We can only give warnings here as F# 5.0 introduces these constraints into existing
// code via Option.ofObj and Option.toObj
- do! WarnD (ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsTrueValue(NicePrint.minimalStringOfType denv ty), getNullnessWarningRange csenv, m2))
+ do! WarnD (ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsTrueValue(NicePrint.minimalRichTextOfType denv ty), getNullnessWarningRange csenv, m2))
elif TypeNullIsExtraValueNew g m ty then
if g.checkNullness then
// Constructor results are provably non-null even for AllowNullLiteral types
@@ -2803,7 +2802,7 @@ and SolveTypeUseNotSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
| TType_app(_, _, Nullness.KnownFromConstructor) -> true
| _ -> false
if not isFromConstructor then
- do! WarnD (ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsExtraValue(NicePrint.minimalStringOfTypeWithNullness denv ty), getNullnessWarningRange csenv, m2))
+ do! WarnD (ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsExtraValue(NicePrint.minimalRichTextOfTypeWithNullness denv ty), getNullnessWarningRange csenv, m2))
else
match tryDestTyparTy g ty with
| ValueSome tp ->
@@ -2831,7 +2830,7 @@ and SolveNullnessNotSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 (trace: O
| NullnessInfo.WithoutNull -> ()
| NullnessInfo.WithNull ->
if g.checkNullness && TypeNullIsExtraValueNew g m ty then
- return! WarnD(ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsExtraValue(NicePrint.minimalStringOfTypeWithNullness denv ty), getNullnessWarningRange csenv, m2))
+ return! WarnD(ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsExtraValue(NicePrint.minimalRichTextOfTypeWithNullness denv ty), getNullnessWarningRange csenv, m2))
| Nullness.KnownFromConstructor -> () // Unreachable after Normalize()
}
@@ -2845,8 +2844,8 @@ and SolveTypeCanCarryNullness (csenv: ConstraintSolverEnv) ty nullness =
if isTyparTy g strippedTy && not (IsReferenceTyparTy g strippedTy) then
return! AddConstraint csenv 0 m NoTrace (destTyparTy g strippedTy) (TyparConstraint.IsReferenceType m)
| None ->
- let tyString = NicePrint.minimalStringOfType csenv.DisplayEnv strippedTy
- return! ErrorD(Error(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyString), m))
+ let tyText = NicePrint.minimalRichTextOfType csenv.DisplayEnv strippedTy
+ return! ErrorD(RichError(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyText), m))
}
and SolveTypeSupportsComparison (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
@@ -2861,7 +2860,7 @@ and SolveTypeSupportsComparison (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
// Check it isn't ruled out by the user
match tryTcrefOfAppTy g ty with
| ValueSome tcref when EntityHasWellKnownAttribute g WellKnownEntityAttributes.NoComparisonAttribute tcref.Deref ->
- ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison1(NicePrint.minimalStringOfType denv ty), m, m2))
+ ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison1(NicePrint.minimalRichTextOfType denv ty), m, m2))
| _ ->
match ty with
| SpecialComparableHeadType g tinst ->
@@ -2889,10 +2888,10 @@ and SolveTypeSupportsComparison (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
AugmentTypeDefinitions.TyconIsCandidateForAugmentationWithCompare g tcref.Deref &&
Option.isNone tcref.GeneratedCompareToWithComparerValues) then
- ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison3(NicePrint.minimalStringOfType denv ty), m, m2))
+ ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison3(NicePrint.minimalRichTextOfType denv ty), m, m2))
else
- ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison2(NicePrint.minimalStringOfType denv ty), m, m2))
+ ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison2(NicePrint.minimalRichTextOfType denv ty), m, m2))
and SolveTypeSupportsEquality (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
let g = csenv.g
@@ -2904,13 +2903,13 @@ and SolveTypeSupportsEquality (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
| _ ->
match tryTcrefOfAppTy g ty with
| ValueSome tcref when EntityHasWellKnownAttribute g WellKnownEntityAttributes.NoEqualityAttribute tcref.Deref ->
- ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality1(NicePrint.minimalStringOfType denv ty), m, m2))
+ ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality1(NicePrint.minimalRichTextOfType denv ty), m, m2))
| _ ->
match ty with
| SpecialEquatableHeadType g tinst ->
tinst |> IterateD (SolveTypeSupportsEquality (csenv: ConstraintSolverEnv) ndeep m2 trace)
| SpecialNotEquatableHeadType g _ ->
- ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality2(NicePrint.minimalStringOfType denv ty), m, m2))
+ ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality2(NicePrint.minimalRichTextOfType denv ty), m, m2))
| _ ->
// The type is equatable because it has Object.Equals(...)
match ty with
@@ -2919,7 +2918,7 @@ and SolveTypeSupportsEquality (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
if AugmentTypeDefinitions.TyconIsCandidateForAugmentationWithEquals g tcref.Deref &&
Option.isNone tcref.GeneratedHashAndEqualsWithComparerValues
then
- ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality3(NicePrint.minimalStringOfType denv ty), m, m2))
+ ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality3(NicePrint.minimalRichTextOfType denv ty), m, m2))
else
// Check the (possibly inferred) structural dependencies
(tinst, tcref.Typars) ||> Iterate2D (fun ty tp ->
@@ -2941,7 +2940,7 @@ and SolveTypeIsEnum (csenv: ConstraintSolverEnv) ndeep m2 trace ty underlying =
if isEnumTy g ty then
SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace underlying (underlyingTypeOfEnumTy g ty)
else
- ErrorD (ConstraintSolverError(FSComp.SR.csTypeIsNotEnumType(NicePrint.minimalStringOfType denv ty), m, m2))
+ ErrorD (ConstraintSolverError(FSComp.SR.csTypeIsNotEnumType(NicePrint.minimalRichTextOfType denv ty), m, m2))
and SolveTypeIsDelegate (csenv: ConstraintSolverEnv) ndeep m2 trace ty aty bty =
let g = csenv.g
@@ -2959,9 +2958,9 @@ and SolveTypeIsDelegate (csenv: ConstraintSolverEnv) ndeep m2 trace ty aty bty =
do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace bty retTy
}
| None ->
- ErrorD (ConstraintSolverError(FSComp.SR.csTypeHasNonStandardDelegateType(NicePrint.minimalStringOfType denv ty), m, m2))
+ ErrorD (ConstraintSolverError(FSComp.SR.csTypeHasNonStandardDelegateType(NicePrint.minimalRichTextOfType denv ty), m, m2))
else
- ErrorD (ConstraintSolverError(FSComp.SR.csTypeIsNotDelegateType(NicePrint.minimalStringOfType denv ty), m, m2))
+ ErrorD (ConstraintSolverError(FSComp.SR.csTypeIsNotDelegateType(NicePrint.minimalRichTextOfType denv ty), m, m2))
and SolveTypeIsNonNullableValueType (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
let g = csenv.g
@@ -2974,11 +2973,11 @@ and SolveTypeIsNonNullableValueType (csenv: ConstraintSolverEnv) ndeep m2 trace
let underlyingTy = stripTyEqnsAndMeasureEqns g ty
if isStructTy g underlyingTy then
if isNullableTy g underlyingTy then
- ErrorD (ConstraintSolverError(FSComp.SR.csTypeParameterCannotBeNullable(), m, m))
+ ErrorD (ConstraintSolverError(RichText.mkText (FSComp.SR.csTypeParameterCannotBeNullable()), m, m))
else
CompleteD
else
- ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresStructType(NicePrint.minimalStringOfType denv ty), m, m2))
+ ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresStructType(NicePrint.minimalRichTextOfType denv ty), m, m2))
and SolveTypeIsUnmanaged (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
let g = csenv.g
@@ -3003,7 +3002,7 @@ and SolveTypeIsUnmanaged (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
if isUnmanagedTy g ty then
CompleteD
else
- ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresUnmanagedType(NicePrint.minimalStringOfType denv ty), m, m2))
+ ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresUnmanagedType(NicePrint.minimalRichTextOfType denv ty), m, m2))
and SolveTypeChoice (csenv: ConstraintSolverEnv) ndeep m2 trace ty choiceTys =
trackErrors {
@@ -3019,9 +3018,9 @@ and SolveTypeChoice (csenv: ConstraintSolverEnv) ndeep m2 trace ty choiceTys =
return! AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.SimpleChoice(choiceTys, m))
| _ ->
if not (choiceTys |> List.exists (typeEquivAux Erasure.EraseMeasures g ty)) then
- let tyString = NicePrint.minimalStringOfType denv ty
- let tysString = choiceTys |> List.map (NicePrint.prettyStringOfTy denv) |> String.concat ","
- return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeNotCompatibleBecauseOfPrintf(tyString, tysString), m, m2))
+ let tyText = NicePrint.minimalRichTextOfType denv ty
+ let tysText = choiceTys |> List.map (LayoutRender.toRichText << NicePrint.prettyLayoutOfType denv) |> RichText.concatWith (RichText.mkText ",")
+ return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeNotCompatibleBecauseOfPrintf(tyText, tysText), m, m2))
}
and SolveTypeIsReferenceType (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
@@ -3035,7 +3034,7 @@ and SolveTypeIsReferenceType (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
// Strip measure equations so we test the underlying erased representation — see dotnet/fsharp#19657.
let underlyingTy = stripTyEqnsAndMeasureEqns g ty
if isRefTy g underlyingTy then CompleteD
- else ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresReferenceSemantics(NicePrint.minimalStringOfType denv ty), m, m))
+ else ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresReferenceSemantics(NicePrint.minimalRichTextOfType denv ty), m, m))
and SolveTypeRequiresDefaultConstructor (csenv: ConstraintSolverEnv) ndeep m2 trace origTy =
let g = csenv.g
@@ -3057,14 +3056,14 @@ and SolveTypeRequiresDefaultConstructor (csenv: ConstraintSolverEnv) ndeep m2 tr
elif TypeHasDefaultValue g m ty then
CompleteD
else
- ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresPublicDefaultConstructor(NicePrint.minimalStringOfType denv origTy), m, m2))
+ ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresPublicDefaultConstructor(NicePrint.minimalRichTextOfType denv origTy), m, m2))
else
if GetIntrinsicConstructorInfosOfType csenv.InfoReader m ty
|> List.exists (fun x -> x.IsNullary && IsMethInfoAccessible amap m AccessibleFromEverywhere x)
then
match tryTcrefOfAppTy g ty with
| ValueSome tcref when EntityHasWellKnownAttribute g WellKnownEntityAttributes.AbstractClassAttribute tcref.Deref ->
- ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresNonAbstract(NicePrint.minimalStringOfType denv origTy), m, m2))
+ ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresNonAbstract(NicePrint.minimalRichTextOfType denv origTy), m, m2))
| _ ->
CompleteD
else
@@ -3075,7 +3074,7 @@ and SolveTypeRequiresDefaultConstructor (csenv: ConstraintSolverEnv) ndeep m2 tr
(tcref.IsRecordTycon && EntityHasWellKnownAttribute g WellKnownEntityAttributes.CLIMutableAttribute tcref.Deref) ->
CompleteD
| _ ->
- ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresPublicDefaultConstructor(NicePrint.minimalStringOfType denv origTy), m, m2))
+ ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresPublicDefaultConstructor(NicePrint.minimalRichTextOfType denv origTy), m, m2))
// Note, this constraint arises structurally when processing the element types of struct tuples and struct anonymous records.
//
@@ -3092,7 +3091,7 @@ and SolveTypeRequiresDefaultValue (csenv: ConstraintSolverEnv) ndeep m2 trace or
elif IsReferenceTyparTy g ty then
SolveTypeUseSupportsNull csenv ndeep m2 trace ty
else
- ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresStructOrReferenceConstraint(), m, m2))
+ ErrorD (ConstraintSolverError(RichText.mkText (FSComp.SR.csGenericConstructRequiresStructOrReferenceConstraint()), m, m2))
else
if isStructTy g ty then
SolveTypeRequiresDefaultConstructor csenv ndeep m2 trace ty
@@ -3146,9 +3145,9 @@ and CanMemberSigsMatchUpToCheck
if calledObjArgTys.Length <> callerObjArgTys.Length then
if calledObjArgTys.Length <> 0 then
- ErrorD(Error (FSComp.SR.csMemberIsNotStatic(minfo.LogicalName), m))
+ ErrorD(RichError(FSComp.SR.csMemberIsNotStatic(RichText.mkMethod minfo.LogicalName), m))
else
- ErrorD(Error (FSComp.SR.csMemberIsNotInstance(minfo.LogicalName), m))
+ ErrorD(RichError(FSComp.SR.csMemberIsNotInstance(RichText.mkMethod minfo.LogicalName), m))
else
// The object types must be non-null
let nonNullCalledObjArgTys =
@@ -3396,21 +3395,21 @@ and ReportNoCandidatesError (csenv: ConstraintSolverEnv) (nUnnamedCallerArgs, nN
// No version accessible
| ([], others), _, _, _, _ ->
if isNil others then
- Error (FSComp.SR.csMemberIsNotAccessible(methodName, (ShowAccessDomain ad)), m)
+ RichError(FSComp.SR.csMemberIsNotAccessible(RichText.mkMethod methodName, RichText.mkText (ShowAccessDomain ad)), m)
else
- Error (FSComp.SR.csMemberIsNotAccessible2(methodName, (ShowAccessDomain ad)), m)
+ RichError(FSComp.SR.csMemberIsNotAccessible2(RichText.mkMethod methodName, RichText.mkText (ShowAccessDomain ad)), m)
| _, ([], cmeth :: _), _, _, _ ->
// Check all the argument types.
if cmeth.CalledObjArgTys(m).Length <> 0 then
- Error (FSComp.SR.csMethodIsNotAStaticMethod(methodName), m)
+ RichError(FSComp.SR.csMethodIsNotAStaticMethod(RichText.mkMethod methodName), m)
else
- Error (FSComp.SR.csMethodIsNotAnInstanceMethod(methodName), m)
+ RichError(FSComp.SR.csMethodIsNotAnInstanceMethod(RichText.mkMethod methodName), m)
// One method, incorrect name/arg assignment
| _, _, _, _, ([], [cmeth]) ->
let minfo = cmeth.Method
- let msgNum, msgText = FSComp.SR.csRequiredSignatureIs(NicePrint.stringOfMethInfo infoReader m denv minfo)
+ let msgNum, msgText = FSComp.SR.csRequiredSignatureIs(NicePrint.richTextOfMethInfo infoReader m denv minfo)
match cmeth.UnassignedNamedArgs with
| CallerNamedArg(id, _) :: _ ->
if minfo.IsConstructor then
@@ -3418,21 +3417,21 @@ and ReportNoCandidatesError (csenv: ConstraintSolverEnv) (nUnnamedCallerArgs, nN
for p in minfo.DeclaringTyconRef.AllInstanceFieldsAsList do
addToBuffer(p.LogicalName.Replace("@", ""))
- ErrorWithSuggestions((msgNum, FSComp.SR.csCtorHasNoArgumentOrReturnProperty(methodName, id.idText, msgText)), id.idRange, id.idText, suggestFields)
+ ErrorWithSuggestions((msgNum, FSComp.SR.csCtorHasNoArgumentOrReturnProperty(RichText.mkMethod methodName, RichText.mkUnresolvedName id.idText, msgText)), id.idRange, id.idText, suggestFields)
else
- Error((msgNum, FSComp.SR.csMemberHasNoArgumentOrReturnProperty(methodName, id.idText, msgText)), id.idRange)
- | [] -> Error((msgNum, msgText), m)
+ RichError((msgNum, FSComp.SR.csMemberHasNoArgumentOrReturnProperty(RichText.mkMethod methodName, RichText.mkUnresolvedName id.idText, msgText)), id.idRange)
+ | [] -> RichError((msgNum, msgText), m)
// One method, incorrect number of arguments provided by the user
| _, _, ([], [cmeth]), _, _ when not cmeth.HasCorrectArity ->
let minfo = cmeth.Method
let nReqd = cmeth.TotalNumUnnamedCalledArgs
let nActual = cmeth.TotalNumUnnamedCallerArgs
- let signature = NicePrint.stringOfMethInfo infoReader m denv minfo
+ let signature = NicePrint.richTextOfMethInfo infoReader m denv minfo
if nActual = nReqd then
let nreqdTyArgs = cmeth.NumCalledTyArgs
let nactualTyArgs = cmeth.NumCallerTyArgs
- Error (FSComp.SR.csMemberSignatureMismatchArityType(methodName, nreqdTyArgs, nactualTyArgs, signature), m)
+ RichError (FSComp.SR.csMemberSignatureMismatchArityType(RichText.mkMethod methodName, nreqdTyArgs, nactualTyArgs, signature), m)
else
let nReqdNamed = cmeth.TotalNumAssignedNamedArgs
@@ -3445,11 +3444,11 @@ and ReportNoCandidatesError (csenv: ConstraintSolverEnv) (nUnnamedCallerArgs, nN
|> List.exists (fun c -> isSequential c.Expr))
if couldBeNameArgs then
- Error (FSComp.SR.csCtorSignatureMismatchArityProp(methodName, nReqd, nActual, signature), m)
+ RichError (FSComp.SR.csCtorSignatureMismatchArityProp(RichText.mkMethod methodName, nReqd, nActual, signature), m)
else
- Error (FSComp.SR.csCtorSignatureMismatchArity(methodName, nReqd, nActual, signature), m)
+ RichError (FSComp.SR.csCtorSignatureMismatchArity(RichText.mkMethod methodName, nReqd, nActual, signature), m)
else
- Error (FSComp.SR.csMemberSignatureMismatchArity(methodName, nReqd, nActual, signature), m)
+ RichError (FSComp.SR.csMemberSignatureMismatchArity(RichText.mkMethod methodName, nReqd, nActual, signature), m)
else
if nReqd > nActual then
let diff = nReqd - nActual
@@ -3457,41 +3456,41 @@ and ReportNoCandidatesError (csenv: ConstraintSolverEnv) (nUnnamedCallerArgs, nN
match NamesOfCalledArgs missingArgs with
| [] ->
if nActual = 0 then
- Error (FSComp.SR.csMemberSignatureMismatch(methodName, diff, signature), m)
+ RichError (FSComp.SR.csMemberSignatureMismatch(RichText.mkMethod methodName, diff, signature), m)
else
- Error (FSComp.SR.csMemberSignatureMismatch2(methodName, diff, signature), m)
+ RichError (FSComp.SR.csMemberSignatureMismatch2(RichText.mkMethod methodName, diff, signature), m)
| names ->
- let str = String.concat ";" (pathOfLid names)
+ let str = RichText.concatWith (RichText.mkText ";") (pathOfLid names |> List.map (RichText.mkParameter))
if nActual = 0 then
- Error (FSComp.SR.csMemberSignatureMismatch3(methodName, diff, signature, str), m)
+ RichError (FSComp.SR.csMemberSignatureMismatch3(RichText.mkMethod methodName, diff, signature, str), m)
else
- Error (FSComp.SR.csMemberSignatureMismatch4(methodName, diff, signature, str), m)
+ RichError (FSComp.SR.csMemberSignatureMismatch4(RichText.mkMethod methodName, diff, signature, str), m)
else
- Error (FSComp.SR.csMemberSignatureMismatchArityNamed(methodName, (nReqd+nReqdNamed), nActual, nReqdNamed, signature), m)
+ RichError (FSComp.SR.csMemberSignatureMismatchArityNamed(RichText.mkMethod methodName, (nReqd+nReqdNamed), nActual, nReqdNamed, signature), m)
// One or more accessible, all the same arity, none correct
| (cmeth :: cmeths2, _), _, _, _, _ when not cmeth.HasCorrectArity && cmeths2 |> List.forall (fun cmeth2 -> cmeth.TotalNumUnnamedCalledArgs = cmeth2.TotalNumUnnamedCalledArgs) ->
- Error (FSComp.SR.csMemberNotAccessible(methodName, nUnnamedCallerArgs, methodName, cmeth.TotalNumUnnamedCalledArgs), m)
+ RichError (FSComp.SR.csMemberNotAccessible(RichText.mkMethod methodName, nUnnamedCallerArgs, RichText.mkMethod methodName, cmeth.TotalNumUnnamedCalledArgs), m)
// Many methods, all with incorrect number of generic arguments
| _, _, _, ([], cmeth :: _), _ ->
- let msg = FSComp.SR.csIncorrectGenericInstantiation((ShowAccessDomain ad), methodName, cmeth.NumCallerTyArgs)
- Error (msg, m)
+ let msg = FSComp.SR.csIncorrectGenericInstantiation(RichText.mkText (ShowAccessDomain ad), RichText.mkMethod methodName, cmeth.NumCallerTyArgs)
+ RichError (msg, m)
// Many methods of different arities, all incorrect
| _, _, ([], cmeth :: _), _, _ ->
let minfo = cmeth.Method
- Error (FSComp.SR.csMemberOverloadArityMismatch(methodName, cmeth.TotalNumUnnamedCallerArgs, (List.sum minfo.NumArgs)), m)
+ RichError (FSComp.SR.csMemberOverloadArityMismatch(RichText.mkMethod methodName, cmeth.TotalNumUnnamedCallerArgs, (List.sum minfo.NumArgs)), m)
| _ ->
let msg =
if nNamedCallerArgs = 0 then
- FSComp.SR.csNoMemberTakesTheseArguments((ShowAccessDomain ad), methodName, nUnnamedCallerArgs)
+ FSComp.SR.csNoMemberTakesTheseArguments(RichText.mkText (ShowAccessDomain ad), RichText.mkMethod methodName, nUnnamedCallerArgs)
else
let s = calledMethGroup |> List.map (fun cmeth -> cmeth.UnassignedNamedArgs |> List.map (fun na -> na.Name)|> Set.ofList) |> Set.intersectMany
if s.IsEmpty then
- FSComp.SR.csNoMemberTakesTheseArguments2((ShowAccessDomain ad), methodName, nUnnamedCallerArgs, nNamedCallerArgs)
+ FSComp.SR.csNoMemberTakesTheseArguments2(RichText.mkText (ShowAccessDomain ad), RichText.mkMethod methodName, nUnnamedCallerArgs, nNamedCallerArgs)
else
let sample = s.MinimumElement
- FSComp.SR.csNoMemberTakesTheseArguments3((ShowAccessDomain ad), methodName, nUnnamedCallerArgs, sample)
- Error (msg, m)
+ FSComp.SR.csNoMemberTakesTheseArguments3(RichText.mkText (ShowAccessDomain ad), RichText.mkMethod methodName, nUnnamedCallerArgs, RichText.mkParameter sample)
+ RichError (msg, m)
|> ErrorD
and ReportNoCandidatesErrorExpr csenv callerArgCounts methodName ad calledMethGroup =
@@ -3673,13 +3672,13 @@ and ResolveOverloading
let minfo = calledMeth.Method
match minfo with
| ILMeth(ilMethInfo= ilMethInfo) when not isStaticConstrainedCall && ilMethInfo.IsStatic && ilMethInfo.IsAbstract ->
- None, ErrorD (Error (FSComp.SR.chkStaticAbstractInterfaceMembers(ilMethInfo.ILName), m)), NoTrace
+ None, ErrorD (RichError(FSComp.SR.chkStaticAbstractInterfaceMembers(RichText.mkMethod ilMethInfo.ILName), m)), NoTrace
| FSMeth(g, _, vref, _) when not isStaticConstrainedCall && not minfo.IsInstance && isInterfaceTy g minfo.ApparentEnclosingType && vref.IsDispatchSlotMember ->
- None, ErrorD (Error (FSComp.SR.chkStaticAbstractInterfaceMembers(minfo.LogicalName), m)), NoTrace
+ None, ErrorD (RichError(FSComp.SR.chkStaticAbstractInterfaceMembers(RichText.mkMethod minfo.LogicalName), m)), NoTrace
| _ -> Some calledMeth, CompleteD, NoTrace
| [], _ when not isOpConversion ->
- None, ErrorD (Error (FSComp.SR.csMethodNotFound(methodName), m)), NoTrace
+ None, ErrorD (RichError(FSComp.SR.csMethodNotFound(RichText.mkMethod methodName), m)), NoTrace
| _, [] when not isOpConversion ->
None, ReportNoCandidatesErrorExpr csenv callerArgs.CallerArgCounts methodName ad calledMethGroup, NoTrace
@@ -4060,7 +4059,7 @@ let UnifyUniqueOverloading
}
| [], _ ->
- ErrorD (Error (FSComp.SR.csMethodNotFound(methodName), m))
+ ErrorD (RichError(FSComp.SR.csMethodNotFound(RichText.mkMethod methodName), m))
| _, [] -> trackErrors {
do! ReportNoCandidatesErrorSynExpr csenv callerArgCounts methodName ad calledMethGroup
return false
diff --git a/src/Compiler/Checking/ConstraintSolver.fsi b/src/Compiler/Checking/ConstraintSolver.fsi
index eebd72c2e60..8bac4a33cde 100644
--- a/src/Compiler/Checking/ConstraintSolver.fsi
+++ b/src/Compiler/Checking/ConstraintSolver.fsi
@@ -155,7 +155,7 @@ exception ConstraintSolverNullnessWarningWithTypes of
exception ConstraintSolverNullnessWarningWithType of DisplayEnv * TType * NullnessInfo * range * range
-exception ConstraintSolverNullnessWarning of string * range * range
+exception ConstraintSolverNullnessWarning of RichText * range * range
exception ConstraintSolverNullnessWarningOnDotAccess of
DisplayEnv *
@@ -165,7 +165,7 @@ exception ConstraintSolverNullnessWarningOnDotAccess of
objExprRange: range *
mMethod: range
-exception ConstraintSolverError of string * range * range
+exception ConstraintSolverError of RichText * range * range
exception ErrorFromApplyingDefault of
tcGlobals: TcGlobals *
diff --git a/src/Compiler/Checking/Expressions/CheckArrayOrListComputedExpressions.fs b/src/Compiler/Checking/Expressions/CheckArrayOrListComputedExpressions.fs
index f8a2abd7d73..a5ccb70702c 100644
--- a/src/Compiler/Checking/Expressions/CheckArrayOrListComputedExpressions.fs
+++ b/src/Compiler/Checking/Expressions/CheckArrayOrListComputedExpressions.fs
@@ -3,6 +3,7 @@
/// Sequence expressions checking
module internal FSharp.Compiler.CheckArrayOrListComputedExpressions
+open FSharp.Compiler.Text
open FSharp.Compiler.CheckBasics
open FSharp.Compiler.ConstraintSolver
open FSharp.Compiler.CheckExpressionsOps
@@ -65,7 +66,7 @@ let TcArrayOrListComputedExpression (cenv: TcFileState) env (overallTy: OverallT
match comp with
| SimpleSemicolonSequence cenv false _ -> ()
| _ when validateExpressionWithIfRequiresParenthesis ->
- errorR (Deprecated(FSComp.SR.tcExpressionWithIfRequiresParenthesis (), m))
+ errorR (Deprecated(RichText.mkText (FSComp.SR.tcExpressionWithIfRequiresParenthesis ()), m))
| _ -> ()
let replacementExpr =
diff --git a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs
index 040b61f9a89..b752a2a3aef 100644
--- a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs
+++ b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs
@@ -297,16 +297,16 @@ let tryGetDataForCustomOperation (nm: Ident) ceenv =
|| (isLikeZip && isLikeGroupJoin)
|| (isLikeJoin && isLikeGroupJoin)
then
- errorR (Error(FSComp.SR.tcCustomOperationInvalid opName, nm.idRange))
+ errorR (RichError(FSComp.SR.tcCustomOperationInvalid (RichText.mkMethod opName), nm.idRange))
if not (ceenv.cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations) then
match ceenv.customOperationMethodsIndexedByMethodName.TryGetValue methInfo.LogicalName with
| true, [ _ ] -> ()
- | _ -> errorR (Error(FSComp.SR.tcCustomOperationMayNotBeOverloaded nm.idText, nm.idRange))
+ | _ -> errorR (RichError(FSComp.SR.tcCustomOperationMayNotBeOverloaded (RichText.mkMethod nm.idText), nm.idRange))
Some opDatas
| true, opData :: _ ->
- errorR (Error(FSComp.SR.tcCustomOperationMayNotBeOverloaded nm.idText, nm.idRange))
+ errorR (RichError(FSComp.SR.tcCustomOperationMayNotBeOverloaded (RichText.mkMethod nm.idText), nm.idRange))
Some [ opData ]
| _ -> None
@@ -317,7 +317,7 @@ let customOperationCheckValidity m f opDatas =
let vs = List.map f opDatas
let v0 = vs[0]
- let (opName,
+ let (opName: string,
_maintainsVarSpaceUsingBind,
_maintainsVarSpace,
_allowInto,
@@ -329,7 +329,7 @@ let customOperationCheckValidity m f opDatas =
opDatas[0]
if not (List.allEqual vs) then
- errorR (Error(FSComp.SR.tcCustomOperationInvalid opName, m))
+ errorR (RichError(FSComp.SR.tcCustomOperationInvalid (RichText.mkMethod opName), m))
v0
@@ -477,21 +477,21 @@ let customOpUsageText ceenv nm =
if isLikeGroupJoin then
Some(
FSComp.SR.customOperationTextLikeGroupJoin (
- nm.idText,
- customOperationJoinConditionWord ceenv nm,
- customOperationJoinConditionWord ceenv nm
+ RichText.mkMethod nm.idText,
+ RichText.mkKeyword (customOperationJoinConditionWord ceenv nm),
+ RichText.mkKeyword (customOperationJoinConditionWord ceenv nm)
)
)
elif isLikeJoin then
Some(
FSComp.SR.customOperationTextLikeJoin (
- nm.idText,
- customOperationJoinConditionWord ceenv nm,
- customOperationJoinConditionWord ceenv nm
+ RichText.mkMethod nm.idText,
+ RichText.mkKeyword (customOperationJoinConditionWord ceenv nm),
+ RichText.mkKeyword (customOperationJoinConditionWord ceenv nm)
)
)
elif isLikeZip then
- Some(FSComp.SR.customOperationTextLikeZip nm.idText)
+ Some(FSComp.SR.customOperationTextLikeZip (RichText.mkMethod nm.idText))
else
None
| _ -> None
@@ -593,7 +593,7 @@ let isCustomOperationProjectionParameter ceenv i (nm: Ident) =
let opDatas = (tryGetDataForCustomOperation nm ceenv).Value
let opName, _, _, _, _, _, _, _j, _ = opDatas[0]
- errorR (Error(FSComp.SR.tcCustomOperationInvalid opName, nm.idRange))
+ errorR (RichError(FSComp.SR.tcCustomOperationInvalid (RichText.mkMethod opName), nm.idRange))
false
[]
@@ -712,12 +712,22 @@ let JoinOrGroupJoinOp ceenv detector synExpr =
Some(nm, innerSourcePat, mJoinCore, false)
// join with bad pattern (gives error on "join" and continues)
| SynExpr.App(_, _, CustomOpId (isCustomOperation ceenv) detector nm, _innerSourcePatExpr, mJoinCore) ->
- errorR (Error(FSComp.SR.tcBinaryOperatorRequiresVariable (nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange))
+ errorR (
+ RichError(
+ FSComp.SR.tcBinaryOperatorRequiresVariable (RichText.mkMethod nm.idText, Option.get (customOpUsageText ceenv nm)),
+ nm.idRange
+ )
+ )
Some(nm, arbPat mJoinCore, mJoinCore, true)
// join (without anything after - gives error on "join" and continues)
| CustomOpId (isCustomOperation ceenv) detector nm ->
- errorR (Error(FSComp.SR.tcBinaryOperatorRequiresVariable (nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange))
+ errorR (
+ RichError(
+ FSComp.SR.tcBinaryOperatorRequiresVariable (RichText.mkMethod nm.idText, Option.get (customOpUsageText ceenv nm)),
+ nm.idRange
+ )
+ )
Some(nm, arbPat synExpr.Range, synExpr.Range, true)
| _ -> None
@@ -742,7 +752,12 @@ let MatchIntoSuffixOrRecover ceenv alreadyGivenError (nm: Ident) synExpr =
(x, intoPat, alreadyGivenError)
| _ ->
if not alreadyGivenError then
- errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange))
+ errorR (
+ RichError(
+ FSComp.SR.tcOperatorIncorrectSyntax (RichText.mkMethod nm.idText, Option.get (customOpUsageText ceenv nm)),
+ nm.idRange
+ )
+ )
(synExpr, arbPat synExpr.Range, true)
@@ -754,7 +769,12 @@ let MatchOnExprOrRecover ceenv alreadyGivenError nm (onExpr: SynExpr) =
suppressErrorReporting (fun () -> TcExprOfUnknownType ceenv.cenv ceenv.env ceenv.tpenv onExpr)
|> ignore
- errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange))
+ errorR (
+ RichError(
+ FSComp.SR.tcOperatorIncorrectSyntax (RichText.mkMethod nm.idText, Option.get (customOpUsageText ceenv nm)),
+ nm.idRange
+ )
+ )
(arbExpr ("_innerSource", onExpr.Range),
mkSynBifix onExpr.Range "=" (arbExpr ("_keySelectors", onExpr.Range)) (arbExpr ("_keySelector2", onExpr.Range)))
@@ -768,7 +788,9 @@ let (|JoinExpr|_|) (ceenv: ComputationExpressionContext<'a>) synExpr =
Some(nm, innerSourcePat, innerSource, keySelectors, mJoinCore)
| JoinOp ceenv (nm, innerSourcePat, mJoinCore, alreadyGivenError) ->
if alreadyGivenError then
- errorR (Error(FSComp.SR.tcOperatorRequiresIn (nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange))
+ errorR (
+ RichError(FSComp.SR.tcOperatorRequiresIn (RichText.mkMethod nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange)
+ )
Some(nm, innerSourcePat, arbExpr ("_innerSource", synExpr.Range), arbKeySelectors synExpr.Range, mJoinCore)
| _ -> None
@@ -785,7 +807,9 @@ let (|GroupJoinExpr|_|) ceenv synExpr =
Some(nm, innerSourcePat, innerSource, keySelectors, intoPat, mGroupJoinCore)
| GroupJoinOp ceenv (nm, innerSourcePat, mGroupJoinCore, alreadyGivenError) ->
if alreadyGivenError then
- errorR (Error(FSComp.SR.tcOperatorRequiresIn (nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange))
+ errorR (
+ RichError(FSComp.SR.tcOperatorRequiresIn (RichText.mkMethod nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange)
+ )
Some(
nm,
@@ -815,13 +839,20 @@ let (|JoinOrGroupJoinOrZipClause|_|) (ceenv: ComputationExpressionContext<'a>) s
// zip (without secondSource or in - gives error)
| CustomOpId (isCustomOperation ceenv) (customOperationIsLikeZip ceenv) nm ->
- errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange))
+ errorR (
+ RichError(
+ FSComp.SR.tcOperatorIncorrectSyntax (RichText.mkMethod nm.idText, Option.get (customOpUsageText ceenv nm)),
+ nm.idRange
+ )
+ )
Some(nm, arbPat synExpr.Range, arbExpr ("_secondSource", synExpr.Range), None, None, synExpr.Range)
// zip secondSource (without in - gives error)
| SynExpr.App(_, _, CustomOpId (isCustomOperation ceenv) (customOperationIsLikeZip ceenv) nm, ExprAsPat secondSourcePat, mZipCore) ->
- errorR (Error(FSComp.SR.tcOperatorIncorrectSyntax (nm.idText, Option.get (customOpUsageText ceenv nm)), mZipCore))
+ errorR (
+ RichError(FSComp.SR.tcOperatorIncorrectSyntax (RichText.mkMethod nm.idText, Option.get (customOpUsageText ceenv nm)), mZipCore)
+ )
Some(nm, secondSourcePat, arbExpr ("_innerSource", synExpr.Range), None, None, mZipCore)
@@ -843,7 +874,12 @@ let (|ForEachThenJoinOrGroupJoinOrZipClause|_|) (ceenv: ComputationExpressionCon
Some(isFromSource, firstSourcePat, firstSource, nm, secondSourcePat, secondSource, keySelectorsOpt, pat3opt, mOpCore, innerComp)
| JoinOrGroupJoinOrZipClause ceenv (nm, pat2, expr2, expr3, pat3opt, mOpCore) when strict ->
- errorR (Error(FSComp.SR.tcBinaryOperatorRequiresBody (nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange))
+ errorR (
+ RichError(
+ FSComp.SR.tcBinaryOperatorRequiresBody (RichText.mkMethod nm.idText, Option.get (customOpUsageText ceenv nm)),
+ nm.idRange
+ )
+ )
Some(
true,
@@ -1011,7 +1047,7 @@ let hasBuilderMethod ceenv m methodName =
/// Checks if a builder method exists and reports an error if it doesn't
let requireBuilderMethod methodName ceenv m1 m2 =
if not (hasBuilderMethod ceenv m1 methodName) then
- error (Error(FSComp.SR.tcRequireBuilderMethod methodName, m2))
+ error (RichError(FSComp.SR.tcRequireBuilderMethod (RichText.mkMethod methodName), m2))
/// One `let`/`use`/`let!`/`use!`/`do!` binding step, exposing whether it is a "bang" construct, its
/// continuation body, and how to rebuild the step around a rewritten body.
@@ -1223,14 +1259,14 @@ let rec TryTranslateComputationExpression
SimplePatsOfPat cenv.synArgNameGenerator secondSourcePat
if Option.isSome later1 then
- errorR (Error(FSComp.SR.tcJoinMustUseSimplePattern nm.idText, firstSourcePat.Range))
+ errorR (RichError(FSComp.SR.tcJoinMustUseSimplePattern (RichText.mkMethod nm.idText), firstSourcePat.Range))
if Option.isSome later2 then
- errorR (Error(FSComp.SR.tcJoinMustUseSimplePattern nm.idText, secondSourcePat.Range))
+ errorR (RichError(FSComp.SR.tcJoinMustUseSimplePattern (RichText.mkMethod nm.idText), secondSourcePat.Range))
// check 'join' or 'groupJoin' or 'zip' is permitted for this builder
match tryGetDataForCustomOperation nm ceenv with
- | None -> error (Error(FSComp.SR.tcMissingCustomOperation nm.idText, nm.idRange))
+ | None -> error (RichError(FSComp.SR.tcMissingCustomOperation (RichText.mkMethod nm.idText), nm.idRange))
| Some opDatas ->
let opName, _, _, _, _, _, _, _, methInfo = opDatas[0]
@@ -1310,7 +1346,9 @@ let rec TryTranslateComputationExpression
SimplePatsOfPat cenv.synArgNameGenerator secondResultPat
if Option.isSome later3 then
- errorR (Error(FSComp.SR.tcJoinMustUseSimplePattern nm.idText, secondResultPat.Range))
+ errorR (
+ RichError(FSComp.SR.tcJoinMustUseSimplePattern (RichText.mkMethod nm.idText), secondResultPat.Range)
+ )
match relExpr with
| JoinRelation ceenv (keySelector1, keySelector2) ->
@@ -1319,13 +1357,15 @@ let rec TryTranslateComputationExpression
if isNullableOp opId.idText then
// When we cannot resolve NullableOps, recommend the relevant namespace to be added
errorR (
- Error(
- FSComp.SR.cannotResolveNullableOperators (ConvertValLogicalNameToDisplayNameCore opId.idText),
+ RichError(
+ FSComp.SR.cannotResolveNullableOperators (
+ RichText.mkOperator (ConvertValLogicalNameToDisplayNameCore opId.idText)
+ ),
relExpr.Range
)
)
else
- errorR (Error(FSComp.SR.tcInvalidRelationInJoin nm.idText, relExpr.Range))
+ errorR (RichError(FSComp.SR.tcInvalidRelationInJoin (RichText.mkMethod nm.idText), relExpr.Range))
let l = wrapInArbErrSequence l "_keySelector1"
let r = wrapInArbErrSequence r "_keySelector2"
@@ -1333,7 +1373,7 @@ let rec TryTranslateComputationExpression
// we've already reported error now we can use operands of binary operation as join components
mkJoinExpr l r secondResultSimplePats, varSpaceWithGroupJoinVars
| _ ->
- errorR (Error(FSComp.SR.tcInvalidRelationInJoin nm.idText, relExpr.Range))
+ errorR (RichError(FSComp.SR.tcInvalidRelationInJoin (RichText.mkMethod nm.idText), relExpr.Range))
// since the shape of relExpr doesn't match our expectations (JoinRelation)
// then we assume that this is l.h.s. of the join relation
// so typechecker will treat relExpr as body of outerKeySelector lambda parameter in GroupJoin method
@@ -1348,20 +1388,22 @@ let rec TryTranslateComputationExpression
if isNullableOp opId.idText then
// When we cannot resolve NullableOps, recommend the relevant namespace to be added
errorR (
- Error(
- FSComp.SR.cannotResolveNullableOperators (ConvertValLogicalNameToDisplayNameCore opId.idText),
+ RichError(
+ FSComp.SR.cannotResolveNullableOperators (
+ RichText.mkOperator (ConvertValLogicalNameToDisplayNameCore opId.idText)
+ ),
relExpr.Range
)
)
else
- errorR (Error(FSComp.SR.tcInvalidRelationInJoin nm.idText, relExpr.Range))
+ errorR (RichError(FSComp.SR.tcInvalidRelationInJoin (RichText.mkMethod nm.idText), relExpr.Range))
// this is not correct JoinRelation but it is still binary operation
// we've already reported error now we can use operands of binary operation as join components
let l = wrapInArbErrSequence l "_keySelector1"
let r = wrapInArbErrSequence r "_keySelector2"
mkJoinExpr l r secondSourceSimplePats, varSpaceWithGroupJoinVars
| _ ->
- errorR (Error(FSComp.SR.tcInvalidRelationInJoin nm.idText, relExpr.Range))
+ errorR (RichError(FSComp.SR.tcInvalidRelationInJoin (RichText.mkMethod nm.idText), relExpr.Range))
// since the shape of relExpr doesn't match our expectations (JoinRelation)
// then we assume that this is l.h.s. of the join relation
// so typechecker will treat relExpr as body of outerKeySelector lambda parameter in Join method
@@ -1685,7 +1727,7 @@ let rec TryTranslateComputationExpression
&& equals mUnit range0
->
error (Error(FSComp.SR.tcEmptyBodyRequiresBuilderZeroMethod (), ceenv.mWhole))
- | _ -> error (Error(FSComp.SR.tcRequireBuilderMethod "Zero", m))
+ | _ -> error (RichError(FSComp.SR.tcRequireBuilderMethod (RichText.mkMethod "Zero"), m))
let mCall = if equals m range0 then ceenv.mWhole else m
Some(translatedCtxt (mkSynCall "Zero" mCall [] ceenv.builderValName))
@@ -2236,7 +2278,7 @@ let rec TryTranslateComputationExpression
loop 2
if maxMergeSources = 1 then
- error (Error(FSComp.SR.tcRequireMergeSourcesOrBindN bindNName, mBind))
+ error (RichError(FSComp.SR.tcRequireMergeSourcesOrBindN (RichText.mkMethod bindNName), mBind))
let rec mergeSources (sourcesAndPats: (SynExpr * SynPat) list) =
let numSourcesAndPats = sourcesAndPats.Length
@@ -2508,7 +2550,12 @@ and ConsumeCustomOpClauses
methInfo
if isLikeZip || isLikeJoin || isLikeGroupJoin then
- errorR (Error(FSComp.SR.tcBinaryOperatorRequiresBody (nm.idText, Option.get (customOpUsageText ceenv nm)), nm.idRange))
+ errorR (
+ RichError(
+ FSComp.SR.tcBinaryOperatorRequiresBody (RichText.mkMethod nm.idText, Option.get (customOpUsageText ceenv nm)),
+ nm.idRange
+ )
+ )
match optionalCont with
| None ->
@@ -2555,7 +2602,10 @@ and ConsumeCustomOpClauses
let expectedArgCount = defaultArg expectedArgCount 0
errorR (
- Error(FSComp.SR.tcCustomOperationHasIncorrectArgCount (nm.idText, expectedArgCount, args.Length), nm.idRange)
+ RichError(
+ FSComp.SR.tcCustomOperationHasIncorrectArgCount (RichText.mkMethod nm.idText, expectedArgCount, args.Length),
+ nm.idRange
+ )
)
mkSynCall
@@ -2583,7 +2633,7 @@ and ConsumeCustomOpClauses
match optionalIntoPat with
| Some intoPat ->
if not (customOperationAllowsInto ceenv nm) then
- error (Error(FSComp.SR.tcOperatorDoesntAcceptInto nm.idText, intoPat.Range))
+ error (RichError(FSComp.SR.tcOperatorDoesntAcceptInto (RichText.mkMethod nm.idText), intoPat.Range))
// Rebind using either for ... or let!....
let rebind =
diff --git a/src/Compiler/Checking/Expressions/CheckComputationExpressionsCustomOps.fs b/src/Compiler/Checking/Expressions/CheckComputationExpressionsCustomOps.fs
index 29cbdfcbb8e..b5ed0a75599 100644
--- a/src/Compiler/Checking/Expressions/CheckComputationExpressionsCustomOps.fs
+++ b/src/Compiler/Checking/Expressions/CheckComputationExpressionsCustomOps.fs
@@ -18,7 +18,7 @@ type DeferredCustomOpSink =
{
KeywordRange: range
OpName: string
- UsageText: unit -> string option
+ UsageText: unit -> RichText option
SyntheticCallRange: range
Fallback: MethInfo
NameEnv: NameResolutionEnv
diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs
index 288f99e67e7..6616c45409a 100644
--- a/src/Compiler/Checking/Expressions/CheckExpressions.fs
+++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs
@@ -140,7 +140,7 @@ exception OverrideInExtrinsicAugmentation of range
exception NonUniqueInferredAbstractSlot of TcGlobals * DisplayEnv * string * MethInfo * MethInfo * range
-exception StandardOperatorRedefinitionWarning of string * range
+exception StandardOperatorRedefinitionWarning of RichText * range
exception InvalidInternalsVisibleToAssemblyName of badName: string * fileName: string option
@@ -516,8 +516,8 @@ let UnifyOverallType (cenv: cenv) (env: TcEnv) m overallTy actualTy =
| TypeDirectedConversionUsed.No -> ()
if AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m reqdTy2 actualTy then
- let reqdTyText, actualTyText, _cxs = NicePrint.minimalStringsOfTwoTypes env.DisplayEnv reqdTy actualTy
- warning (Error(FSComp.SR.tcSubsumptionImplicitConversionUsed(actualTyText, reqdTyText), m))
+ let reqdTyText, actualTyText, _cxs = NicePrint.minimalRichTextsOfTwoTypes env.DisplayEnv reqdTy actualTy
+ warning (RichError(FSComp.SR.tcSubsumptionImplicitConversionUsed(actualTyText, reqdTyText), m))
else
// report the error
UnifyTypes cenv env m reqdTy actualTy
@@ -789,10 +789,10 @@ let UnifyUnitType (cenv: cenv) (env: TcEnv) m ty expr =
| ContextInfo.SequenceExpression seqTy ->
let liftedTy = mkSeqTy g ty
if typeEquiv g seqTy liftedTy then
- warning (Error (FSComp.SR.implicitlyDiscardedInSequenceExpression(NicePrint.prettyStringOfTy denv ty), m))
+ warning (RichError(FSComp.SR.implicitlyDiscardedInSequenceExpression(NicePrint.prettyRichTextOfTy denv ty), m))
else
if isListTy g ty || isArrayTy g ty || typeEquiv g seqTy ty then
- warning (Error (FSComp.SR.implicitlyDiscardedSequenceInSequenceExpression(NicePrint.prettyStringOfTy denv ty), m))
+ warning (RichError(FSComp.SR.implicitlyDiscardedSequenceInSequenceExpression(NicePrint.prettyRichTextOfTy denv ty), m))
else
reportImplicitlyDiscardError()
| _ ->
@@ -1076,14 +1076,14 @@ let TcAddNullnessToType (warn: bool) (cenv: cenv) (env: TcEnv) nullness innerTyC
let g = cenv.g
if g.langFeatureNullness then
if TypeNullNever g innerTyC then
- let tyString = NicePrint.minimalStringOfType env.DisplayEnv innerTyC
- errorR(Error(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyString), m))
+ let tyText = NicePrint.minimalRichTextOfType env.DisplayEnv innerTyC
+ errorR(RichError(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyText), m))
match tryAddNullnessToTy nullness innerTyC with
| None ->
- let tyString = NicePrint.minimalStringOfType env.DisplayEnv innerTyC
- errorR(Error(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyString), m))
+ let tyText = NicePrint.minimalRichTextOfType env.DisplayEnv innerTyC
+ errorR(RichError(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyText), m))
innerTyC
| Some innerTyCWithNull ->
@@ -1178,12 +1178,12 @@ let MakeMemberDataAndMangledNameForMemberVal(g, tcref, isExtrinsic, attrs, implS
let displayName = ConvertValLogicalNameToDisplayNameCore logicalName
// Check symbolic members. Expect valSynData implied arity to be [[2]].
match SynInfo.AritiesOfArgs valSynData with
- | [] | [0] -> warning(Error(FSComp.SR.memberOperatorDefinitionWithNoArguments displayName, m))
+ | [] | [0] -> warning(RichError(FSComp.SR.memberOperatorDefinitionWithNoArguments (RichText.mkMember displayName), m))
| n :: otherArgs ->
let opTakesThreeArgs = IsLogicalTernaryOperator logicalName
- if n<>2 && not opTakesThreeArgs then warning(Error(FSComp.SR.memberOperatorDefinitionWithNonPairArgument(displayName, n), m))
- if n<>3 && opTakesThreeArgs then warning(Error(FSComp.SR.memberOperatorDefinitionWithNonTripleArgument(displayName, n), m))
- if not (isNil otherArgs) then warning(Error(FSComp.SR.memberOperatorDefinitionWithCurriedArguments displayName, m))
+ if n<>2 && not opTakesThreeArgs then warning(RichError(FSComp.SR.memberOperatorDefinitionWithNonPairArgument(RichText.mkMember displayName, n), m))
+ if n<>3 && opTakesThreeArgs then warning(RichError(FSComp.SR.memberOperatorDefinitionWithNonTripleArgument(RichText.mkMember displayName, n), m))
+ if not (isNil otherArgs) then warning(RichError(FSComp.SR.memberOperatorDefinitionWithCurriedArguments (RichText.mkMember displayName), m))
if isExtrinsic && IsLogicalOpName id.idText then
warning(Error(FSComp.SR.tcMemberOperatorDefinitionInExtrinsic(), id.idRange))
@@ -1314,32 +1314,32 @@ let CheckForAbnormalOperatorNames (cenv: cenv) (idRange: range) coreDisplayName
match opName with
| Relational ->
if isMember then
- warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidMethodNameForRelationalOperator(opName, coreDisplayName), idRange))
+ warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidMethodNameForRelationalOperator(RichText.mkOperator opName, RichText.mkMember coreDisplayName), idRange))
else
- warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidOperatorDefinitionRelational opName, idRange))
+ warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidOperatorDefinitionRelational(RichText.mkOperator opName), idRange))
| Equality ->
if isMember then
- warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidMethodNameForEquality(opName, coreDisplayName), idRange))
+ warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidMethodNameForEquality(RichText.mkOperator opName, RichText.mkMember coreDisplayName), idRange))
else
- warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidOperatorDefinitionEquality opName, idRange))
+ warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidOperatorDefinitionEquality(RichText.mkOperator opName), idRange))
| Control ->
if isMember then
- warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidMemberName(opName, coreDisplayName), idRange))
+ warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidMemberName(RichText.mkOperator opName, RichText.mkMember coreDisplayName), idRange))
else
- warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidOperatorDefinition opName, idRange))
+ warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidOperatorDefinition(RichText.mkOperator opName), idRange))
| Indexer ->
if not isMember then
- error(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidIndexOperatorDefinition opName, idRange))
+ error(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidIndexOperatorDefinition(RichText.mkOperator opName), idRange))
| FixedTypes ->
if isMember then
- warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidMemberNameFixedTypes opName, idRange))
+ warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidMemberNameFixedTypes(RichText.mkOperator opName), idRange))
| Other -> ()
-let CheckInitProperties (g: TcGlobals) (minfo: MethInfo) methodName mItem =
+let CheckInitProperties (g: TcGlobals) (minfo: MethInfo) (methodName: string) mItem =
if g.langVersion.SupportsFeature(LanguageFeature.InitPropertiesSupport) then
// Check, whether this method has external init, emit an error diagnostic in this case.
if minfo.HasExternalInit then
- errorR (Error (FSComp.SR.tcSetterForInitOnlyPropertyCannotBeCalled1 methodName, mItem))
+ errorR (RichError(FSComp.SR.tcSetterForInitOnlyPropertyCannotBeCalled1 (RichText.mkProperty methodName), mItem))
let CheckRequiredProperties (g:TcGlobals) (env: TcEnv) (cenv: TcFileState) (minfo: MethInfo) finalAssignedItemSetters mMethExpr =
// Make sure, if apparent type has any required properties, they all are in the `finalAssignedItemSetters`.
@@ -1373,7 +1373,7 @@ let CheckRequiredProperties (g:TcGlobals) (env: TcEnv) (cenv: TcFileState) (minf
|> List.filter (fun pinfo -> not (Set.contains pinfo.PropertyName setterPropNames))
if missingProps.Length > 0 then
let details = NicePrint.multiLineStringOfPropInfos g cenv.amap mMethExpr env.DisplayEnv missingProps
- errorR(Error(FSComp.SR.tcMissingRequiredMembers details, mMethExpr))
+ errorR(RichError(FSComp.SR.tcMissingRequiredMembers (RichText.mkText details), mMethExpr))
let private HasMethodImplNoInliningAttribute g attrs =
match attrs with
@@ -1652,7 +1652,7 @@ let ChooseCanonicalDeclaredTyparsAfterInference g denv declaredTypars m =
declaredTypars |> List.iter (fun tp ->
let ty = mkTyparTy tp
if not (isAnyParTy g ty) then
- error(Error(FSComp.SR.tcLessGenericBecauseOfAnnotation(tp.Name, NicePrint.prettyStringOfTy denv ty), tp.Range)))
+ error(RichError(FSComp.SR.tcLessGenericBecauseOfAnnotation(RichText.mkTypeParameter tp.Name, NicePrint.prettyRichTextOfTy denv ty), tp.Range)))
let declaredTypars = NormalizeDeclaredTyparsForEquiRecursiveInference g declaredTypars
@@ -1677,9 +1677,9 @@ let SetTyparRigid denv m (tp: Typar) =
| None -> ()
| Some ty ->
if tp.IsCompilerGenerated then
- errorR(Error(FSComp.SR.tcGenericParameterHasBeenConstrained(NicePrint.prettyStringOfTy denv ty), m))
+ errorR(RichError(FSComp.SR.tcGenericParameterHasBeenConstrained(NicePrint.prettyRichTextOfTy denv ty), m))
else
- errorR(Error(FSComp.SR.tcTypeParameterHasBeenConstrained(NicePrint.prettyStringOfTy denv ty), tp.Range))
+ errorR(RichError(FSComp.SR.tcTypeParameterHasBeenConstrained(NicePrint.prettyRichTextOfTy denv ty), tp.Range))
tp.SetRigidity TyparRigidity.Rigid
let GeneralizeVal (cenv: cenv) denv enclosingDeclaredTypars generalizedTyparsForThisBinding prelimVal =
@@ -1993,7 +1993,7 @@ let CheckRecdExprDuplicateFields (elems: Ident list) =
elems |> List.iteri (fun i (uc1: Ident) ->
elems |> List.iteri (fun j (uc2: Ident) ->
if j > i && uc1.idText = uc2.idText then
- errorR (Error(FSComp.SR.tcMultipleFieldsInRecord(uc1.idText), uc1.idRange))))
+ errorR (RichError(FSComp.SR.tcMultipleFieldsInRecord(RichText.mkRecordField uc1.idText), uc1.idRange))))
//-------------------------------------------------------------------------
// Helpers to typecheck expressions and patterns
@@ -2066,7 +2066,7 @@ let BuildFieldMap (cenv: cenv) env isPartial ty (flds: ((Ident list * Ident) * '
CheckFSharpAttributes g fref2.PropertyAttribs ident.idRange |> CommitOperationResult
if showDeprecated then
- let diagnostic = Deprecated(FSComp.SR.nrRecordTypeNeedsQualifiedAccess(fref2.FieldName, fref2.Tycon.DisplayName) |> snd, m)
+ let diagnostic = Deprecated(FSComp.SR.nrRecordTypeNeedsQualifiedAccess(RichText.mkRecordField fref2.FieldName, richTextOfEntity fref2.Tycon) |> snd, m)
if g.langVersion.SupportsFeature(LanguageFeature.ErrorOnDeprecatedRequireQualifiedAccess) then
errorR(diagnostic)
else
@@ -2096,7 +2096,7 @@ let ApplyUnionCaseOrExn (makerForUnionCase, makerForExnTag) m mItemIdent (cenv:
| Item.UnionCase(ucinfo, showDeprecated) ->
if showDeprecated then
- let diagnostic = Deprecated(FSComp.SR.nrUnionTypeNeedsQualifiedAccess(ucinfo.DisplayName, ucinfo.Tycon.DisplayName) |> snd, mItemIdent)
+ let diagnostic = Deprecated(FSComp.SR.nrUnionTypeNeedsQualifiedAccess(RichText.mkUnionCase ucinfo.DisplayName, richTextOfEntity ucinfo.Tycon) |> snd, mItemIdent)
if g.langVersion.SupportsFeature(LanguageFeature.ErrorOnDeprecatedRequireQualifiedAccess) then
errorR(diagnostic)
else
@@ -2361,7 +2361,7 @@ module GeneralizationHelpers =
for tp in allDeclaredTypars do
if Zset.memberOf freeInEnv tp then
let ty = mkTyparTy tp
- error(Error(FSComp.SR.tcNotSufficientlyGenericBecauseOfScope(NicePrint.prettyStringOfTy denv ty), m))
+ error(RichError(FSComp.SR.tcNotSufficientlyGenericBecauseOfScope(NicePrint.prettyRichTextOfTy denv ty), m))
let generalizedTypars = CondenseTypars(cenv, denv, generalizedTypars, tauTy, m)
@@ -2635,7 +2635,7 @@ module BindingNormalization =
NormalizedBindingPat(pat, rhsExpr, valSynData, typars)
else
if isObjExprBinding = ObjExprBinding then
- errorR(Deprecated(FSComp.SR.tcObjectExpressionFormDeprecated(), m))
+ errorR(Deprecated(RichText.mkText (FSComp.SR.tcObjectExpressionFormDeprecated()), m))
MakeNormalizedStaticOrValBinding cenv isObjExprBinding id vis typars args rhsExpr valSynData
| _ ->
error(Error(FSComp.SR.tcInvalidDeclaration(), m))
@@ -2831,7 +2831,7 @@ let TcValEarlyGeneralizationConsistencyCheck (cenv: cenv) (env: TcEnv) (v: Val,
let vTauTy = instType (mkTyparInst vTypars tinst) vTauTy
if not (AddCxTypeEqualsTypeUndoIfFailed env.DisplayEnv cenv.css m tau vTauTy) then
let txt = buildString (fun buf -> NicePrint.outputQualifiedValSpec env.DisplayEnv cenv.infoReader buf (mkLocalValRef v))
- error(Error(FSComp.SR.tcInferredGenericTypeGivesRiseToInconsistency(v.DisplayName, txt), m)))
+ error(RichError(FSComp.SR.tcInferredGenericTypeGivesRiseToInconsistency(richTextOfValName g v, RichText.mkText txt), m)))
| _ -> ()
@@ -2853,7 +2853,7 @@ let TcVal (cenv: cenv) env (tpenv: UnscopedTyparEnv) (vref: ValRef) instantiatio
// Don't count compiler-generated refs (synthetic range) for FS1182
if not m.IsSynthetic then v.SetHasBeenReferenced()
- CheckValAccessible m env.eAccessRights vref
+ CheckValAccessible g m env.eAccessRights vref
CheckValAttributes g vref m |> CommitOperationResult
@@ -2892,7 +2892,7 @@ let TcVal (cenv: cenv) env (tpenv: UnscopedTyparEnv) (vref: ValRef) instantiatio
// No explicit instantiation (the normal case)
| None ->
if ValHasWellKnownAttribute g WellKnownValAttributes.RequiresExplicitTypeArgumentsAttribute v then
- errorR(Error(FSComp.SR.tcFunctionRequiresExplicitTypeArguments(v.DisplayName), m))
+ errorR(RichError(FSComp.SR.tcFunctionRequiresExplicitTypeArguments(richTextOfValName g v), m))
match valRecInfo with
| ValInRecScope false ->
@@ -2908,7 +2908,7 @@ let TcVal (cenv: cenv) env (tpenv: UnscopedTyparEnv) (vref: ValRef) instantiatio
| Some(vrefFlags, checkTys) ->
let checkInst (tinst: TypeInst) =
if not v.IsMember && not v.PermitsExplicitTypeInstantiation && not (List.isEmpty tinst) && not (List.isEmpty v.Typars) then
- warning(Error(FSComp.SR.tcDoesNotAllowExplicitTypeArguments(v.DisplayName), m))
+ warning(RichError(FSComp.SR.tcDoesNotAllowExplicitTypeArguments(richTextOfValName g v), m))
match valRecInfo with
| ValInRecScope false ->
let vTypars, vTauTy = vref.GeneralizedType
@@ -3083,24 +3083,24 @@ let TcRuntimeTypeTest isCast isOperator (cenv: cenv) denv m tgtTy srcTy =
if isErasedType g tgtTy then
if isCast then
- warning(Error(FSComp.SR.tcTypeCastErased(NicePrint.minimalStringOfType denv tgtTy, NicePrint.minimalStringOfType denv (stripTyEqnsWrtErasure EraseAll g tgtTy)), m))
+ warning(RichError(FSComp.SR.tcTypeCastErased(NicePrint.minimalRichTextOfType denv tgtTy, NicePrint.minimalRichTextOfType denv (stripTyEqnsWrtErasure EraseAll g tgtTy)), m))
else
- error(Error(FSComp.SR.tcTypeTestErased(NicePrint.minimalStringOfType denv tgtTy, NicePrint.minimalStringOfType denv (stripTyEqnsWrtErasure EraseAll g tgtTy)), m))
+ error(RichError(FSComp.SR.tcTypeTestErased(NicePrint.minimalRichTextOfType denv tgtTy, NicePrint.minimalRichTextOfType denv (stripTyEqnsWrtErasure EraseAll g tgtTy)), m))
else
let checkTrgtNullness =
match (srcTy,g),(tgtTy,g) with
| (NullableRefType|NullTrueValue|NullableTypar), WithoutNullRefType when g.checkNullness && isCast ->
- let srcNice = NicePrint.minimalStringOfTypeWithNullness denv srcTy
- let tgtNice = NicePrint.minimalStringOfTypeWithNullness denv tgtTy
- warning(Error(FSComp.SR.tcDowncastFromNullableToWithoutNull(srcNice,tgtNice,tgtNice), m))
+ let srcNice = NicePrint.minimalRichTextOfTypeWithNullness denv srcTy
+ let tgtNice = NicePrint.minimalRichTextOfTypeWithNullness denv tgtTy
+ warning(RichError(FSComp.SR.tcDowncastFromNullableToWithoutNull(srcNice, tgtNice, tgtNice), m))
false
| (NullableRefType|NullTrueValue|NullableTypar), (NullableRefType|NullTrueValue|NullableTypar) -> not isCast //a type test (unlike type cast) will never return true for null in the source, therefore adding |null to target does not help => keep the erasure warning
| _ -> true
for ety in getErasedTypes g tgtTy checkTrgtNullness do
if isMeasureTy g ety then
- warning(Error(FSComp.SR.tcTypeTestLosesMeasures(NicePrint.minimalStringOfType denv ety), m))
+ warning(RichError(FSComp.SR.tcTypeTestLosesMeasures(NicePrint.minimalRichTextOfType denv ety), m))
else
- warning(Error(FSComp.SR.tcTypeTestLossy(NicePrint.minimalStringOfTypeWithNullness denv ety, NicePrint.minimalStringOfType denv (stripTyEqnsWrtErasure EraseAll g ety)), m))
+ warning(RichError(FSComp.SR.tcTypeTestLossy(NicePrint.minimalRichTextOfTypeWithNullness denv ety, NicePrint.minimalRichTextOfType denv (stripTyEqnsWrtErasure EraseAll g ety)), m))
/// Checks, warnings and constraint assertions for upcasts
let TcStaticUpcast (cenv: cenv) denv mSourceExpr mUpcastExpr tgtTy srcTy =
@@ -3250,7 +3250,7 @@ let private CheckFieldLiteralArg (finfo: ILFieldInfo) argExpr m =
match stripDebugPoints argExpr with
| Expr.Const (v, _, _) ->
let literalValue = string v
- error (Error(FSComp.SR.tcLiteralFieldAssignmentWithArg literalValue, m))
+ error (RichError(FSComp.SR.tcLiteralFieldAssignmentWithArg (RichText.mkText literalValue), m))
| _ ->
error (Error(FSComp.SR.tcLiteralFieldAssignmentNoArg(), m))
)
@@ -3373,9 +3373,9 @@ let AnalyzeArbitraryExprAsEnumerable (cenv: cenv) (env: TcEnv) localAlloc m expr
let g = cenv.g
let err k ty =
- let txt = NicePrint.minimalStringOfType env.DisplayEnv ty
+ let txt = NicePrint.minimalRichTextOfType env.DisplayEnv ty
let msg = if k then FSComp.SR.tcTypeCannotBeEnumerated txt else FSComp.SR.tcEnumTypeCannotBeEnumerated txt
- Exception(Error(msg, m))
+ Exception(RichError(msg, m))
let findMethInfo k m nm ty =
match TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad nm ty with
@@ -4698,7 +4698,7 @@ and CheckIWSAM (cenv: cenv) (env: TcEnv) checkConstraints iwsam m tcref =
if meths |> List.exists (fun meth -> not meth.IsInstance && meth.IsDispatchSlot && not meth.IsExtensionMember) then
let tcref = tcrefOfAppTy g ty
- warning(Error(FSComp.SR.tcUsingInterfaceWithStaticAbstractMethodAsType(tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m))
+ warning(RichError(FSComp.SR.tcUsingInterfaceWithStaticAbstractMethodAsType(richTextOfEntityRefName tcref tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m))
and TcLongIdentType kindOpt (cenv: cenv) newOk checkConstraints occ iwsam env tpenv synLongId =
let (SynLongIdent(tc, _, _)) = synLongId
@@ -4793,7 +4793,7 @@ and CheckAnonRecdTypeDuplicateFields (elems: Ident array) =
elems |> Array.iteri (fun i (uc1: Ident) ->
elems |> Array.iteri (fun j (uc2: Ident) ->
if j > i && uc1.idText = uc2.idText then
- errorR(Error(FSComp.SR.tcAnonRecdTypeDuplicateFieldId(uc1.idText), uc1.idRange))))
+ errorR(RichError(FSComp.SR.tcAnonRecdTypeDuplicateFieldId(RichText.mkRecordField uc1.idText), uc1.idRange))))
and TcAnonRecdType (cenv: cenv) newOk checkConstraints occ env tpenv isStruct args m =
let tupInfo = mkTupInfo isStruct
@@ -4890,7 +4890,7 @@ and TcTypeStaticConstant kindOpt tpenv c m =
and TcTypeMeasurePower kindOpt (cenv: cenv) newOk checkConstraints occ env tpenv ty exponent m =
match kindOpt with
| Some TyparKind.Type ->
- errorR(Error(FSComp.SR.tcUnexpectedSymbolInTypeExpression("^"), m))
+ errorR(RichError(FSComp.SR.tcUnexpectedSymbolInTypeExpression(RichText.mkOperator "^"), m))
NewErrorType (), tpenv
| _ ->
let ms, tpenv = TcMeasure cenv newOk checkConstraints occ env tpenv ty m
@@ -5012,7 +5012,7 @@ and TcTyparConstraints (cenv: cenv) newOk checkConstraints occ env tpenv synCons
#if !NO_TYPEPROVIDERS
and TcStaticConstantParameter (cenv: cenv) (env: TcEnv) tpenv kind (StripParenTypes v) idOpt container =
let g = cenv.g
- let fail() = error(Error(FSComp.SR.etInvalidStaticArgument(NicePrint.minimalStringOfType env.DisplayEnv kind), v.Range))
+ let fail() = error(RichError(FSComp.SR.etInvalidStaticArgument(NicePrint.minimalRichTextOfType env.DisplayEnv kind), v.Range))
let record ttype =
match idOpt with
| Some id ->
@@ -5099,16 +5099,16 @@ and CrackStaticConstantArgs (cenv: cenv) env tpenv (staticParameters: Tainted List.filter (fun (j, sp) -> j >= unnamedArgs.Length && n.idText = sp.PUntaint((fun sp -> sp.Name), m)) with
| [] ->
if staticParameters |> Array.exists (fun sp -> n.idText = sp.PUntaint((fun sp -> sp.Name), n.idRange)) then
- error (Error(FSComp.SR.etStaticParameterAlreadyHasValue n.idText, n.idRange))
+ error (RichError(FSComp.SR.etStaticParameterAlreadyHasValue (RichText.mkParameter n.idText), n.idRange))
else
let availableNames =
staticParameters
|> Array.map (fun sp -> sp.PUntaint((fun sp -> sp.Name), n.idRange))
|> formatAvailableNames
- error (Error(FSComp.SR.etNoStaticParameterWithName (n.idText, availableNames), n.idRange))
+ error (RichError(FSComp.SR.etNoStaticParameterWithName(RichText.mkUnresolvedName n.idText, RichText.mkText availableNames), n.idRange))
| [_] -> ()
- | _ -> error (Error(FSComp.SR.etMultipleStaticParameterWithName n.idText, n.idRange))
+ | _ -> error (RichError(FSComp.SR.etMultipleStaticParameterWithName(RichText.mkParameter n.idText), n.idRange))
if staticParameters.Length < namedArgs.Length + unnamedArgs.Length then
error (Error(FSComp.SR.etTooManyStaticParameters(staticParameters.Length, unnamedArgs.Length, namedArgs.Length), m))
@@ -5129,12 +5129,12 @@ and CrackStaticConstantArgs (cenv: cenv) env tpenv (staticParameters: Tainted
if sp.PUntaint((fun sp -> sp.IsOptional), m) then
match sp.PUntaint((fun sp -> sp.RawDefaultValue), m) with
- | null -> error (Error(FSComp.SR.etStaticParameterRequiresAValue (spName, containerName, containerName, spName), m))
+ | null -> error (RichError(FSComp.SR.etStaticParameterRequiresAValue (RichText.mkParameter spName, RichText.mkQualifiedTypeName containerName, RichText.mkQualifiedTypeName containerName, RichText.mkParameter spName), m))
| v -> v
else
- error (Error(FSComp.SR.etStaticParameterRequiresAValue (spName, containerName, containerName, spName), m))
+ error (RichError(FSComp.SR.etStaticParameterRequiresAValue (RichText.mkParameter spName, RichText.mkQualifiedTypeName containerName, RichText.mkQualifiedTypeName containerName, RichText.mkParameter spName), m))
| ps ->
- error (Error(FSComp.SR.etMultipleStaticParameterWithName spName, (fst (List.last ps)).idRange)))
+ error (RichError(FSComp.SR.etMultipleStaticParameterWithName (RichText.mkParameter spName), (fst (List.last ps)).idRange)))
argsInStaticParameterOrderIncludingDefaults
@@ -5191,7 +5191,7 @@ and TcProvidedTypeApp (cenv: cenv) env tpenv tcref args m =
//printfn "adding entity for provided type '%s', isDirectReferenceToGenerated = %b, isGenerated = %b" (st.PUntaint((fun st -> st.Name), m)) isDirectReferenceToGenerated isGenerated
let isDirectReferenceToGenerated = isGenerated && IsGeneratedTypeDirectReference (providedTypeAfterStaticArguments, m)
if isDirectReferenceToGenerated then
- error(Error(FSComp.SR.etDirectReferenceToGeneratedTypeNotAllowed(tcref.DisplayName), m))
+ error(RichError(FSComp.SR.etDirectReferenceToGeneratedTypeNotAllowed(richTextOfEntityRef tcref), m))
// We put the type name check after the 'isDirectReferenceToGenerated' check because we need the 'isDirectReferenceToGenerated' error to be shown for generated types
checkTypeName()
@@ -5410,11 +5410,11 @@ and TcPatLongIdentActivePatternCase warnOnUpper (cenv: cenv) (env: TcEnv) vFlags
let caseName = apinfo.ActiveTags[idx]
let msg =
match paramCount, returnCount with
- | 0, 0 -> FSComp.SR.tcActivePatternArgsCountNotMatchNoArgsNoPat(caseName, caseName)
- | 0, _ -> FSComp.SR.tcActivePatternArgsCountNotMatchOnlyPat(caseName)
- | _, 0 -> FSComp.SR.tcActivePatternArgsCountNotMatchArgs(paramCount, caseName, fmtExprArgs paramCount)
- | _, _ -> FSComp.SR.tcActivePatternArgsCountNotMatchArgsAndPat(paramCount, caseName, fmtExprArgs paramCount)
- error(Error(msg, m))
+ | 0, 0 -> FSComp.SR.tcActivePatternArgsCountNotMatchNoArgsNoPat(RichText.mkActivePatternCase caseName, RichText.mkActivePatternCase caseName)
+ | 0, _ -> FSComp.SR.tcActivePatternArgsCountNotMatchOnlyPat(RichText.mkActivePatternCase caseName)
+ | _, 0 -> FSComp.SR.tcActivePatternArgsCountNotMatchArgs(paramCount, RichText.mkActivePatternCase caseName, RichText.mkText (fmtExprArgs paramCount))
+ | _, _ -> FSComp.SR.tcActivePatternArgsCountNotMatchArgsAndPat(paramCount, RichText.mkActivePatternCase caseName, RichText.mkText (fmtExprArgs paramCount))
+ error(RichError(msg, m))
let isUnsolvedTyparTy g ty = tryDestTyparTy g ty |> ValueOption.exists (fun typar -> not typar.IsSolved)
@@ -6520,7 +6520,7 @@ and TcExprTryFinally (cenv: cenv) overallTy env tpenv (synBodyExpr, synFinallyEx
mkTryFinally g (bodyExpr, finallyExpr, mTryToLast, overallTy.Commit, spTry, spFinally), tpenv
and TcExprJoinIn (cenv: cenv) overallTy env tpenv (synExpr1, mInToken, synExpr2, mAll) =
- errorR(Error(FSComp.SR.parsUnfinishedExpression("in"), mInToken))
+ errorR(RichError(FSComp.SR.parsUnfinishedExpression(RichText.mkKeyword "in"), mInToken))
let _, _, tpenv = suppressErrorReporting (fun () -> TcExprOfUnknownType cenv env tpenv synExpr1)
let _, _, tpenv = suppressErrorReporting (fun () -> TcExprOfUnknownType cenv env tpenv synExpr2)
mkDefault(mAll, overallTy.Commit), tpenv
@@ -6697,7 +6697,7 @@ and TcIteratedLambdas (cenv: cenv) isFirst (env: TcEnv) overallTy takenNames tpe
// See bug 5758: Non-monotonicity in inference: need to ensure that parameters are never inferred to have byref type, instead it is always declared
byrefs |> Map.iter (fun _ (orig, v) ->
- if not orig && isByrefTy g v.Type then errorR(Error(FSComp.SR.tcParameterInferredByref v.DisplayName, v.Range)))
+ if not orig && isByrefTy g v.Type then errorR(RichError(FSComp.SR.tcParameterInferredByref (RichText.mkParameter v.DisplayName), v.Range)))
mkMultiLambda m vspecs (bodyExpr, resultTy), tpenv
@@ -7006,7 +7006,7 @@ and TcNewExpr cenv env tpenv objTy mObjTyOpt superInit arg mWholeExprOrObjTy =
mkCallCreateInstance g mWholeExprOrObjTy objTy, tpenv
else
- if not (isAppTy g objTy) && not (isAnyTupleTy g objTy) then error(Error(FSComp.SR.tcNamedTypeRequired(if superInit then "inherit" else "new"), mWholeExprOrObjTy))
+ if not (isAppTy g objTy) && not (isAnyTupleTy g objTy) then error(RichError(FSComp.SR.tcNamedTypeRequired(RichText.mkKeyword (if superInit then "inherit" else "new")), mWholeExprOrObjTy))
let item = ForceRaise (ResolveObjectConstructor cenv.nameResolver env.DisplayEnv mWholeExprOrObjTy ad objTy)
TcCtorCall false cenv env tpenv (MustEqual objTy) objTy mObjTyOpt item superInit [arg] mWholeExprOrObjTy [] None
@@ -7056,7 +7056,7 @@ and TcCtorCall isNaked cenv env tpenv (overallTy: OverallTy) objTy mObjTyOpt ite
TcNewDelegateThen cenv (MustEqual objTy) env tpenv mItem mWholeCall ty arg ExprAtomicFlag.NonAtomic delayed
| _ ->
- error(Error(FSComp.SR.tcSyntaxCanOnlyBeUsedToCreateObjectTypes(if superInit then "inherit" else "new"), mWholeCall))
+ error(RichError(FSComp.SR.tcSyntaxCanOnlyBeUsedToCreateObjectTypes(RichText.mkKeyword (if superInit then "inherit" else "new")), mWholeCall))
// Check a record construction expression
and TcRecordConstruction (cenv: cenv) (overallTy: TType) isObjExpr env tpenv withExprInfoOpt objTy fldsList m =
@@ -7069,7 +7069,7 @@ and TcRecordConstruction (cenv: cenv) (overallTy: TType) isObjExpr env tpenv wit
// Types with implicit constructors can't use record or object syntax: all constructions must go through the implicit constructor
let supportsObjectExpressionWithoutOverrides = isObjExpr && g.langVersion.SupportsFeature(LanguageFeature.AllowObjectExpressionWithoutOverrides)
if not supportsObjectExpressionWithoutOverrides && tycon.MembersOfFSharpTyconByName |> NameMultiMap.existsInRange (fun v -> v.IsIncrClassConstructor) then
- errorR(Error(FSComp.SR.tcConstructorRequiresCall(tycon.DisplayName), m))
+ errorR(RichError(FSComp.SR.tcConstructorRequiresCall(richTextOfEntity tycon), m))
let fspecs = tycon.TrueInstanceFieldsAsList
// Freshen types and work out their subtype flexibility
@@ -7079,7 +7079,7 @@ and TcRecordConstruction (cenv: cenv) (overallTy: TType) isObjExpr env tpenv wit
try
fspecs |> List.find (fun fspec -> fspec.LogicalName = fname)
with :? KeyNotFoundException ->
- error (Error(FSComp.SR.tcUndefinedField(fname, NicePrint.minimalStringOfType env.DisplayEnv objTy), m))
+ error (RichError(FSComp.SR.tcUndefinedField(RichText.mkUnresolvedName fname, NicePrint.minimalRichTextOfType env.DisplayEnv objTy), m))
let fty = actualTyOfRecdFieldForTycon tycon tinst fspec
let flex = not (isTyparTy g fty)
yield (fname, fexpr, fty, flex) ]
@@ -7114,7 +7114,7 @@ and TcRecordConstruction (cenv: cenv) (overallTy: TType) isObjExpr env tpenv wit
// Check all fields are bound
fspecs |> List.iter (fun fspec ->
if not (fldsList |> List.exists (fun (fname, _) -> fname = fspec.LogicalName)) then
- error(Error(FSComp.SR.tcFieldRequiresAssignment(fspec.rfield_id.idText, fullDisplayTextOfTyconRef tcref), m)))
+ error(RichError(FSComp.SR.tcFieldRequiresAssignment(RichText.mkRecordField fspec.rfield_id.idText, richTextOfQualifiedTyconRef tcref), m)))
// Other checks (overlap with above check now clear)
let ns1 = NameSet.ofList (List.map fst fldsList)
@@ -7129,7 +7129,7 @@ and TcRecordConstruction (cenv: cenv) (overallTy: TType) isObjExpr env tpenv wit
// Don't emit the warning for nested field updates, because it does not really make sense.
if oldFldsList.IsEmpty && not m.IsSynthetic then
let enabledByLangFeature = g.langVersion.SupportsFeature LanguageFeature.WarningWhenCopyAndUpdateRecordChangesAllFields
- warning(ErrorEnabledWithLanguageFeature(FSComp.SR.tcCopyAndUpdateRecordChangesAllFields(fullDisplayTextOfTyconRef tcref), m, enabledByLangFeature))
+ warning(ErrorEnabledWithLanguageFeature(FSComp.SR.tcCopyAndUpdateRecordChangesAllFields(richTextOfQualifiedTyconRef tcref), m, enabledByLangFeature))
if not (Zset.subset ns1 ns2) then
error (Error(FSComp.SR.tcExtraneousFieldsGivenValues(), m))
@@ -7230,15 +7230,15 @@ and FreshenObjExprAbstractSlot (cenv: cenv) (env: TcEnv) (implTy: TType) virtNam
addToBuffer x
if containsNonAbstractMemberWithSameName then
- errorR(ErrorWithSuggestions(FSComp.SR.tcMemberFoundIsNotAbstractOrVirtual(tcref.DisplayName, bindName), mBinding, bindName, suggestVirtualMembers))
+ errorR(ErrorWithSuggestions(FSComp.SR.tcMemberFoundIsNotAbstractOrVirtual(richTextOfEntityRef tcref, RichText.mkMember bindName), mBinding, bindName, suggestVirtualMembers))
else
- errorR(ErrorWithSuggestions(FSComp.SR.tcNoAbstractOrVirtualMemberFound bindName, mBinding, bindName, suggestVirtualMembers))
+ errorR(ErrorWithSuggestions(FSComp.SR.tcNoAbstractOrVirtualMemberFound (RichText.mkMember bindName), mBinding, bindName, suggestVirtualMembers))
| [ (_, absSlot: MethInfo) ] ->
- errorR(Error(FSComp.SR.tcArgumentArityMismatch(bindName, List.sum absSlot.NumArgs, arity, getSignature absSlot, getDetails absSlot), mBinding))
+ errorR(RichError(FSComp.SR.tcArgumentArityMismatch(RichText.mkMember bindName, List.sum absSlot.NumArgs, arity, RichText.mkText (getSignature absSlot), RichText.mkText (getDetails absSlot)), mBinding))
| (_, absSlot) :: _ ->
- errorR(Error(FSComp.SR.tcArgumentArityMismatchOneOverload(bindName, List.sum absSlot.NumArgs, arity, getSignature absSlot, getDetails absSlot), mBinding))
+ errorR(RichError(FSComp.SR.tcArgumentArityMismatchOneOverload(RichText.mkMember bindName, List.sum absSlot.NumArgs, arity, RichText.mkText (getSignature absSlot), RichText.mkText (getDetails absSlot)), mBinding))
None
@@ -7616,7 +7616,7 @@ and TcFormatStringExpr cenv (overallTy: OverallTy) env m tpenv (fmtString: strin
let _argTys, atyRequired, etyRequired, _percentATys, specifierLocations, _dotnetFormatString =
try CheckFormatStrings.ParseFormatString m [m] g false false formatStringCheckContext normalizedString bty cty dty
- with Failure errString -> error (Error(FSComp.SR.tcUnableToParseFormatString errString, m))
+ with Failure errString -> error (RichError(FSComp.SR.tcUnableToParseFormatString (RichText.mkText errString), m))
match cenv.tcSink.CurrentSink with
| None -> ()
@@ -7764,7 +7764,7 @@ and TcInterpolatedStringExpr cenv (overallTy: OverallTy) env m tpenv (parts: Syn
try
CheckFormatStrings.ParseFormatString m stringFragmentRanges g true isFormattableString None printfFormatString printerArgTy printerResidueTy printerResultTy
with Failure errString ->
- error (Error(FSComp.SR.tcUnableToParseInterpolatedString errString, m))
+ error (RichError(FSComp.SR.tcUnableToParseInterpolatedString (RichText.mkText errString), m))
// Check the expressions filling the holes
if argTys.Length <> synFillExprs.Length then
@@ -7909,7 +7909,7 @@ and TcConstExpr cenv (overallTy: OverallTy) env m tpenv c =
let ad = env.eAccessRights
match ResolveLongIdentAsModuleOrNamespace cenv.tcSink cenv.amap m true OpenQualified env.eNameResEnv ad (ident (modName, m)) [] false ShouldNotifySink.Yes with
| Result []
- | Exception _ -> error(Error(FSComp.SR.tcNumericLiteralRequiresModule modName, m))
+ | Exception _ -> error(RichError(FSComp.SR.tcNumericLiteralRequiresModule (RichText.mkModule modName), m))
| Result ((_, mref, _) :: _) ->
let expr =
try
@@ -8094,7 +8094,7 @@ and CheckAnonRecdExprDuplicateFields (elems: Ident array) =
elems |> Array.iteri (fun i (uc1: Ident) ->
elems |> Array.iteri (fun j (uc2: Ident) ->
if j > i && uc1.idText = uc2.idText then
- errorR(Error (FSComp.SR.tcAnonRecdDuplicateFieldId(uc1.idText), uc1.idRange))))
+ errorR(RichError(FSComp.SR.tcAnonRecdDuplicateFieldId(RichText.mkRecordField uc1.idText), uc1.idRange))))
// Check '{| .... |}'
and TcAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, optOrigSynExpr, unsortedFieldIdsAndSynExprsGiven, mWholeExpr) =
@@ -8108,7 +8108,7 @@ and TcAnonRecdExpr cenv (overallTy: TType) env tpenv (isStruct, optOrigSynExpr,
unsortedFieldIdsAndSynExprsGiven
|> List.countBy (fun (fId, _, _) -> textOfLid fId.LongIdent)
|> List.iter (fun (label, count) ->
- if count > 1 then error (Error (FSComp.SR.tcAnonRecdDuplicateFieldId(label), mWholeExpr)))
+ if count > 1 then error (RichError(FSComp.SR.tcAnonRecdDuplicateFieldId(RichText.mkRecordField label), mWholeExpr)))
TcCopyAndUpdateAnonRecdExpr cenv overallTy env tpenv (isStruct, orig, unsortedFieldIdsAndSynExprsGiven, mWholeExpr)
@@ -8581,13 +8581,13 @@ and Propagate (cenv: cenv) (overallTy: OverallTy) (env: TcEnv) tpenv (expr: Appl
error (NotAFunctionButIndexer(denv, overallTy.Commit, vName, mExpr, mArg, false))
match vName with
| Some nm ->
- error(Error(FSComp.SR.tcNotAFunctionButIndexerNamedIndexingNotYetEnabled(nm, nm), mExprAndArg))
+ error(RichError(FSComp.SR.tcNotAFunctionButIndexerNamedIndexingNotYetEnabled(RichText.mkMember nm, RichText.mkMember nm), mExprAndArg))
| _ ->
error(Error(FSComp.SR.tcNotAFunctionButIndexerIndexingNotYetEnabled(), mExprAndArg))
else
match vName with
| Some nm ->
- error(Error(FSComp.SR.tcNotAnIndexerNamedIndexingNotYetEnabled(nm), mExprAndArg))
+ error(RichError(FSComp.SR.tcNotAnIndexerNamedIndexingNotYetEnabled(RichText.mkMember nm), mExprAndArg))
| _ ->
error(Error(FSComp.SR.tcNotAnIndexerIndexingNotYetEnabled(), mExprAndArg))
else
@@ -9005,8 +9005,8 @@ and TcItemThen (cenv: cenv) (overallTy: OverallTy) env tpenv (tinstEnclosing, it
// 'delayed' is about to be dropped on the floor, first do rudimentary checking to get name resolutions in its body
RecordNameAndTypeResolutionsDelayed cenv env tpenv delayed
match usageTextOpt() with
- | None -> error(Error(FSComp.SR.tcCustomOperationNotUsedCorrectly nm, mItemIdent))
- | Some usageText -> error(Error(FSComp.SR.tcCustomOperationNotUsedCorrectly2(nm, usageText), mItemIdent))
+ | None -> error(RichError(FSComp.SR.tcCustomOperationNotUsedCorrectly (RichText.mkMethod nm), mItemIdent))
+ | Some usageText -> error(RichError(FSComp.SR.tcCustomOperationNotUsedCorrectly2(RichText.mkMethod nm, usageText), mItemIdent))
// These items are not expected here - they are only used for reporting symbols from name resolution to language service
| Item.ActivePatternCase _
@@ -9106,7 +9106,7 @@ and TcUnionCaseOrExnCaseOrActivePatternResultItemThen (cenv: cenv) overallTy env
| Item.ExnCase tref -> Item.RecdField (RecdFieldInfo ([], RecdFieldRef (tref, id.idText)))
| _ -> failwithf "Expecting union case or exception item, got: %O" item
CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, argItem, emptyTyparInst, ItemOccurrence.Use, ad)
- else error(Error(FSComp.SR.tcUnionCaseFieldCannotBeUsedMoreThanOnce(id.idText), id.idRange))
+ else error(RichError(FSComp.SR.tcUnionCaseFieldCannotBeUsedMoreThanOnce(RichText.mkRecordField id.idText), id.idRange))
currentIndex <- SEEN_NAMED_ARGUMENT
| None ->
// ambiguity may appear only when if argument is boolean\generic.
@@ -9130,13 +9130,13 @@ and TcUnionCaseOrExnCaseOrActivePatternResultItemThen (cenv: cenv) overallTy env
else
match item with
| Item.UnionCase(uci, _) ->
- error(Error(FSComp.SR.tcUnionCaseConstructorDoesNotHaveFieldWithGivenName(uci.DisplayName, id.idText), id.idRange))
+ error(RichError(FSComp.SR.tcUnionCaseConstructorDoesNotHaveFieldWithGivenName(RichText.mkUnionCase uci.DisplayName, RichText.mkUnresolvedName id.idText), id.idRange))
| Item.ExnCase tcref ->
- error(Error(FSComp.SR.tcExceptionConstructorDoesNotHaveFieldWithGivenName(tcref.DisplayName, id.idText), id.idRange))
+ error(RichError(FSComp.SR.tcExceptionConstructorDoesNotHaveFieldWithGivenName(richTextOfEntityRef tcref, RichText.mkUnresolvedName id.idText), id.idRange))
| Item.ActivePatternResult _ ->
error(Error(FSComp.SR.tcActivePatternsDoNotHaveFields(), id.idRange))
| _ ->
- error(Error(FSComp.SR.tcConstructorDoesNotHaveFieldWithGivenName(id.idText), id.idRange))
+ error(RichError(FSComp.SR.tcConstructorDoesNotHaveFieldWithGivenName(RichText.mkUnresolvedName id.idText), id.idRange))
assert (Seq.forall (box >> ((<>) null) ) fittedArgs)
List.ofArray fittedArgs
@@ -9329,12 +9329,12 @@ and TcTraitItemThen (cenv: cenv) overallTy env objOpt traitInfo tpenv mItem dela
match traitInfo.SupportTypes with
| tys when tys.Length > 1 ->
- error(Error (FSComp.SR.tcTraitHasMultipleSupportTypes(traitInfo.MemberDisplayNameCore), mItem))
+ error(RichError(FSComp.SR.tcTraitHasMultipleSupportTypes(RichText.mkMember traitInfo.MemberDisplayNameCore), mItem))
| _ -> ()
match objOpt, traitInfo.MemberFlags.IsInstance with
- | Some _, false -> error (Error (FSComp.SR.tcTraitIsStatic traitInfo.MemberDisplayNameCore, mItem))
- | None, true -> error (Error (FSComp.SR.tcTraitIsNotStatic traitInfo.MemberDisplayNameCore, mItem))
+ | Some _, false -> error (RichError(FSComp.SR.tcTraitIsStatic (RichText.mkMember traitInfo.MemberDisplayNameCore), mItem))
+ | None, true -> error (RichError(FSComp.SR.tcTraitIsNotStatic (RichText.mkMember traitInfo.MemberDisplayNameCore), mItem))
| _ -> ()
// If this is an instance trait the object must be evaluated, just in case this is a first-class use of the trait, e.g.
@@ -9535,7 +9535,7 @@ and TcValueItemThen cenv overallTy env vref tpenv mItem mItemIdent afterResoluti
if not (isNil otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(), mStmt))
UnifyTypes cenv env mStmt overallTy.Commit g.unit_ty
vref.Deref.SetHasBeenReferenced()
- CheckValAccessible mItemIdent env.AccessRights vref
+ CheckValAccessible g mItemIdent env.AccessRights vref
CheckValAttributes g vref mItemIdent |> CommitOperationResult
let vTy = vref.Type
let vty2 =
@@ -9643,7 +9643,7 @@ and TcPropertyItemThen cenv overallTy env nm pinfos tpenv mItem mItemIdent after
ExprAtomicFlag.Atomic, None, [mkSynUnit mItem], delayed, tpenv
if not pinfo.IsStatic then
- error (Error (FSComp.SR.tcPropertyIsNotStatic nm, mItemIdent))
+ error (RichError(FSComp.SR.tcPropertyIsNotStatic (RichText.mkProperty nm), mItemIdent))
match delayed with
| DelayedSet(expr2, mStmt) :: otherDelayed ->
@@ -9659,21 +9659,21 @@ and TcPropertyItemThen cenv overallTy env nm pinfos tpenv mItem mItemIdent after
let isByrefMethReturnSetter = meths |> List.exists (function _,Some pinfo -> isByrefTy g (pinfo.GetPropertyType(cenv.amap,mItem)) | _ -> false)
if not isByrefMethReturnSetter then
- errorR (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItemIdent))
+ errorR (RichError(FSComp.SR.tcPropertyCannotBeSet1 (RichText.mkProperty nm), mItemIdent))
// x.P <- ... byref setter
- if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItemIdent))
+ if isNil meths then error (RichError(FSComp.SR.tcPropertyIsNotReadable (RichText.mkProperty nm), mItemIdent))
TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mItem mItemIdent nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic staticTyOpt delayed
else
let args = if pinfo.IsIndexer then args else []
if isNil meths then
- errorR (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItemIdent))
+ errorR (RichError(FSComp.SR.tcPropertyCannotBeSet1 (RichText.mkProperty nm), mItemIdent))
// Note: static calls never mutate a struct object argument
TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mStmt mItemIdent nm ad NeverMutates true meths afterResolution NormalValUse (args@[expr2]) ExprAtomicFlag.NonAtomic staticTyOpt otherDelayed
| _ ->
// Static Property Get (possibly indexer)
let meths = pinfos |> GettersOfPropInfos
- if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItemIdent))
+ if isNil meths then error (RichError(FSComp.SR.tcPropertyIsNotReadable (RichText.mkProperty nm), mItemIdent))
// Note: static calls never mutate a struct object argument
TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt [] mItem mItemIdent nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic staticTyOpt delayed
@@ -9729,7 +9729,7 @@ and TcRecdFieldItemThen cenv overallTy env rfinfo tpenv mItem mItemIdent delayed
let g = cenv.g
let ad = env.eAccessRights
CheckRecdFieldInfoAccessible cenv.amap mItemIdent ad rfinfo
- if not rfinfo.IsStatic then error (Error (FSComp.SR.tcFieldIsNotStatic(rfinfo.DisplayName), mItemIdent))
+ if not rfinfo.IsStatic then error (RichError(FSComp.SR.tcFieldIsNotStatic(RichText.mkRecordField rfinfo.DisplayName), mItemIdent))
CheckRecdFieldInfoAttributes g rfinfo mItemIdent |> CommitOperationResult
let fref = rfinfo.RecdFieldRef
let fieldTy = rfinfo.FieldType
@@ -9851,7 +9851,7 @@ and TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed
if pinfo.IsIndexer
then GetMemberApplicationArgs delayed cenv env tpenv
else ExprAtomicFlag.Atomic, None, [mkSynUnit mItem], delayed, tpenv
- if pinfo.IsStatic then error (Error (FSComp.SR.tcPropertyIsStatic nm, mItemIdent))
+ if pinfo.IsStatic then error (RichError(FSComp.SR.tcPropertyIsStatic (RichText.mkProperty nm), mItemIdent))
match delayed with
@@ -9864,14 +9864,14 @@ and TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed
let meths = pinfos |> GettersOfPropInfos
let isByrefMethReturnSetter = meths |> List.exists (function _,Some pinfo -> isByrefTy g (pinfo.GetPropertyType(cenv.amap,mItem)) | _ -> false)
if not isByrefMethReturnSetter then
- errorR (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItemIdent))
+ errorR (RichError(FSComp.SR.tcPropertyCannotBeSet1 (RichText.mkProperty nm), mItemIdent))
// x.P <- ... byref setter
- if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItemIdent))
+ if isNil meths then error (RichError(FSComp.SR.tcPropertyIsNotReadable (RichText.mkProperty nm), mItemIdent))
TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItemIdent nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag None delayed
else
if g.langVersion.SupportsFeature(LanguageFeature.RequiredPropertiesSupport) && pinfo.IsSetterInitOnly then
- errorR (Error (FSComp.SR.tcInitOnlyPropertyCannotBeSet1 nm, mItemIdent))
+ errorR (RichError(FSComp.SR.tcInitOnlyPropertyCannotBeSet1 (RichText.mkProperty nm), mItemIdent))
let args = if pinfo.IsIndexer then args else []
let mut = (if isStructTy g (tyOfExpr g objExpr) then DefinitelyMutates else PossiblyMutates)
@@ -9879,7 +9879,7 @@ and TcLookupItemThen cenv overallTy env tpenv mObjExpr objExpr objExprTy delayed
| _ ->
// Instance property getter
let meths = GettersOfPropInfos pinfos
- if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItemIdent))
+ if isNil meths then error (RichError(FSComp.SR.tcPropertyIsNotReadable (RichText.mkProperty nm), mItemIdent))
TcMethodApplicationThen cenv env overallTy None tpenv tyArgsOpt objArgs mExprAndItem mItemIdent nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag None delayed
| Item.RecdField rfinfo ->
@@ -9981,8 +9981,8 @@ and TcEventItemThen (cenv: cenv) overallTy env tpenv mItem mItemIdent mExprAndIt
let nm = einfo.EventName
match objDetails, einfo.IsStatic with
- | Some _, true -> error (Error (FSComp.SR.tcEventIsStatic nm, mItemIdent))
- | None, false -> error (Error (FSComp.SR.tcEventIsNotStatic nm, mItemIdent))
+ | Some _, true -> error (RichError(FSComp.SR.tcEventIsStatic (RichText.mkEvent nm), mItemIdent))
+ | None, false -> error (RichError(FSComp.SR.tcEventIsNotStatic (RichText.mkEvent nm), mItemIdent))
| _ -> ()
// The F# wrappers around events are null safe (impl is in FSharp.Core). Therefore, from an F# perspective, the type of the delegate can be considered Not Null.
@@ -10073,14 +10073,14 @@ and TcMethodApplicationThen
// Give errors if some things couldn't be assigned
if not (isNil attributeAssignedNamedItems) then
let (CallerNamedArg(id, _)) = List.head attributeAssignedNamedItems
- errorR(Error(FSComp.SR.tcNamedArgumentDidNotMatch(id.idText), id.idRange))
+ errorR(RichError(FSComp.SR.tcNamedArgumentDidNotMatch(RichText.mkParameter id.idText), id.idRange))
// Resolve the "delayed" lookups
let exprTy = (tyOfExpr g expr)
for problematicTy in GetDisallowedNullness g exprTy do
let denv = env.DisplayEnv
- warning(Error(FSComp.SR.tcDisallowedNullableApplication(methodName,NicePrint.minimalStringOfType denv problematicTy), m))
+ warning(RichError(FSComp.SR.tcDisallowedNullableApplication(RichText.mkMethod methodName, NicePrint.minimalRichTextOfType denv problematicTy), m))
PropagateThenTcDelayed cenv overallTy env tpenv mWholeExpr (MakeApplicableExprNoFlex cenv expr) exprTy atomicFlag delayed
@@ -10651,7 +10651,7 @@ and TcMethodApplication
if not finalCalledMeth.IsIndexParamArraySetter &&
not finalCalledMeth.IsIndexerSetter &&
(finalCalledMeth.ArgSets |> List.existsi (fun i argSet -> argSet.UnnamedCalledArgs |> List.existsi (fun j ca -> ca.Position <> (i, j)))) then
- errorR(Deprecated(FSComp.SR.tcUnnamedArgumentsDoNotFormPrefix(), mMethExpr))
+ errorR(Deprecated(RichText.mkText (FSComp.SR.tcUnnamedArgumentsDoNotFormPrefix()), mMethExpr))
/// STEP 5. Build the argument list. Adjust for optional arguments, byref arguments and coercions.
@@ -10782,7 +10782,7 @@ and TcSetterArgExpr (cenv: cenv) env denv objExpr ad assignedSetter calledFromCo
CheckPropInfoAttributes pinfo id.idRange |> CommitOperationResult
if g.langVersion.SupportsFeature(LanguageFeature.RequiredPropertiesSupport) && pinfo.IsSetterInitOnly && not calledFromConstructor then
- errorR (Error (FSComp.SR.tcInitOnlyPropertyCannotBeSet1 pinfo.PropertyName, m))
+ errorR (RichError(FSComp.SR.tcInitOnlyPropertyCannotBeSet1 (RichText.mkProperty pinfo.PropertyName), m))
MethInfoChecks g cenv.amap true None [objExpr] ad m pminfo
let calledArgTy = List.head (List.head (pminfo.GetParamTypes(cenv.amap, m, pminst)))
@@ -11434,7 +11434,7 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt
errorR(Error(FSComp.SR.tcPartialActivePattern(), m))
if Option.isSome memberFlagsOpt && not spatsL.IsEmpty then
- errorR(Error(FSComp.SR.tcInvalidActivePatternName(apinfo.LogicalName), m))
+ errorR(RichError(FSComp.SR.tcInvalidActivePatternName(RichText.mkActivePatternCase apinfo.LogicalName), m))
apinfo.ActiveTagsWithRanges |> List.iteri (fun i (_tag, tagRange) ->
let item = Item.ActivePatternResult(apinfo, apOverallTy, i, tagRange)
@@ -11749,7 +11749,7 @@ and TcAttributeEx canFail (cenv: cenv) (env: TcEnv) attrTgt attrEx (synAttr: Syn
match canFail with
| TcCanFail.IgnoreAllErrors | TcCanFail.IgnoreMemberResoutionError -> [], true
| TcCanFail.ReportAllErrors ->
- errorR(Error(FSComp.SR.tcGenericAttributesNotSupported(tcref.DisplayName), mAttr))
+ errorR(RichError(FSComp.SR.tcGenericAttributesNotSupported(richTextOfEntityRef tcref), mAttr))
[], false
else
@@ -11815,7 +11815,7 @@ and TcAttributeEx canFail (cenv: cenv) (env: TcEnv) attrTgt attrEx (synAttr: Syn
let checkPropSetterAttribAccess m (pinfo: PropInfo) =
let setterMeth = pinfo.SetterMethod
if not <| IsTypeAndMethInfoAccessible cenv.amap m ad ad setterMeth then
- errorR(Error (FSComp.SR.tcPropertyCannotBeSetPrivateSetter(pinfo.PropertyName), m))
+ errorR(RichError(FSComp.SR.tcPropertyCannotBeSetPrivateSetter(RichText.mkProperty pinfo.PropertyName), m))
let namedAttribArgMap =
attributeAssignedNamedItems |> List.map (fun (CallerNamedArg(id, CallerArg(callerArgTy, m, isOpt, callerArgExpr))) ->
@@ -12209,8 +12209,8 @@ and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (_: Val option) (a
| meths when methInfosEquivByNameAndSig meths -> meths
| [] ->
let raiseGenericArityMismatch() =
- let details = NicePrint.multiLineStringOfMethInfos cenv.infoReader m envinner.DisplayEnv slots
- errorR(Error(FSComp.SR.tcOverrideArityMismatch details, memberId.idRange))
+ let details = NicePrint.multiLineRichTextOfMethInfos cenv.infoReader m envinner.DisplayEnv slots
+ errorR(RichError(FSComp.SR.tcOverrideArityMismatch details, memberId.idRange))
[]
match slot with
@@ -12304,7 +12304,7 @@ and ApplyAbstractSlotInference (cenv: cenv) (envinner: TcEnv) (_: Val option) (a
let kIsGet = (k = SynMemberKind.PropertyGet)
if not (if kIsGet then uniqueAbstractProp.HasGetter else uniqueAbstractProp.HasSetter) then
- error(Error(FSComp.SR.tcAbstractPropertyMissingGetOrSet(if kIsGet then "getter" else "setter"), memberId.idRange))
+ error(RichError(FSComp.SR.tcAbstractPropertyMissingGetOrSet(RichText.mkText (if kIsGet then "getter" else "setter")), memberId.idRange))
let uniqueAbstractMeth = if kIsGet then uniqueAbstractProp.GetterMethod else uniqueAbstractProp.SetterMethod
@@ -12814,7 +12814,7 @@ and TcLetrecBinding
| Some thisVal ->
reqdThisValTy, thisVal.Type, thisVal.Range
if not (AddCxTypeEqualsTypeUndoIfFailed envRec.DisplayEnv cenv.css rangeForCheck actualThisValTy reqdThisValTy) then
- errorR (Error(FSComp.SR.tcNonUniformMemberUse vspec.DisplayName, vspec.Range))
+ errorR (RichError(FSComp.SR.tcNonUniformMemberUse (richTextOfValName g vspec), vspec.Range))
let preGeneralizationRecBind =
{ RecBindingInfo = rbind.RecBindingInfo
@@ -13213,7 +13213,7 @@ and FixupLetrecBind (cenv: cenv) denv generalizedTyparsForRecursiveBlock (bind:
and unionGeneralizedTypars typarSets = List.foldBack (ListSet.unionFavourRight typarEq) typarSets []
-and CheckRecursiveInlineGroup (bindings: PreInitializationGraphEliminationBinding list) =
+and CheckRecursiveInlineGroup g (bindings: PreInitializationGraphEliminationBinding list) =
let inlineBindings =
bindings
|> List.filter (fun pgrbind ->
@@ -13260,7 +13260,7 @@ and CheckRecursiveInlineGroup (bindings: PreInitializationGraphEliminationBindin
// via the FS1113/FS1114/FS1118 "not bound in optimization environment" cascade.
// This momentarily surfaces the binding as non-inline to the language service,
// which is acceptable because compilation already fails here with FS3890.
- errorR(Error(FSComp.SR.tcRecursiveInlineNotAllowed(v.DisplayName), v.Range))
+ errorR(RichError(FSComp.SR.tcRecursiveInlineNotAllowed(richTextOfValName g v), v.Range))
v.SetInlineInfo ValInline.Never
and TcLetrecBindings overridesOK (cenv: cenv) env tpenv (binds, bindsm, scopem) =
@@ -13296,7 +13296,7 @@ and TcLetrecBindings overridesOK (cenv: cenv) env tpenv (binds, bindsm, scopem)
// Now that we know what we've generalized we can adjust the recursive references
let vxbinds = vxbinds |> List.map (FixupLetrecBind cenv env.DisplayEnv generalizedTyparsForRecursiveBlock)
- CheckRecursiveInlineGroup vxbinds
+ CheckRecursiveInlineGroup g vxbinds
// Now eliminate any initialization graphs
let binds =
diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fsi b/src/Compiler/Checking/Expressions/CheckExpressions.fsi
index 4fc6a1dfde7..43675b8e823 100644
--- a/src/Compiler/Checking/Expressions/CheckExpressions.fsi
+++ b/src/Compiler/Checking/Expressions/CheckExpressions.fsi
@@ -117,7 +117,7 @@ exception OverrideInExtrinsicAugmentation of range
exception NonUniqueInferredAbstractSlot of TcGlobals * DisplayEnv * string * MethInfo * MethInfo * range
-exception StandardOperatorRedefinitionWarning of string * range
+exception StandardOperatorRedefinitionWarning of RichText * range
exception InvalidInternalsVisibleToAssemblyName of badName: string * fileName: string option
@@ -484,7 +484,7 @@ val FixupLetrecBind:
/// Detect recursive 'inline' bindings within a recursive binding group and
/// emit FS3890. Mutates inline info to suppress downstream cascades.
-val CheckRecursiveInlineGroup: bindings: PreInitializationGraphEliminationBinding list -> unit
+val CheckRecursiveInlineGroup: g: TcGlobals -> bindings: PreInitializationGraphEliminationBinding list -> unit
/// Produce a fresh view of an object type, e.g. 'List' becomes 'List' for new
/// inference variables with the given rigidity.
diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs
index 2a4e75135f1..424fb9f178a 100644
--- a/src/Compiler/Checking/InfoReader.fs
+++ b/src/Compiler/Checking/InfoReader.fs
@@ -1031,7 +1031,7 @@ type InfoReader(g: TcGlobals, amap: ImportMap) as this =
let checkLanguageFeatureRuntimeAndRecover (infoReader: InfoReader) langFeature m =
if not (infoReader.IsLanguageFeatureRuntimeSupported langFeature) then
let featureStr = LanguageVersion.GetFeatureString langFeature
- errorR (Error(FSComp.SR.chkFeatureNotRuntimeSupported featureStr, m))
+ errorR (RichError(FSComp.SR.chkFeatureNotRuntimeSupported (RichText.mkText featureStr), m))
let GetIntrinsicConstructorInfosOfType (infoReader: InfoReader) m ty =
infoReader.GetIntrinsicConstructorInfosOfTypeAux m ty ty
diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs
index 156e52faee1..93ced76c9ed 100644
--- a/src/Compiler/Checking/MethodCalls.fs
+++ b/src/Compiler/Checking/MethodCalls.fs
@@ -220,9 +220,9 @@ let TryFindRelevantImplicitConversion (infoReader: InfoReader) ad reqdTy actualT
Some (minfo, staticTy, (reqdTy, reqdTy2, ignore))
| (minfo, staticTy) :: _ ->
Some (minfo, staticTy, (reqdTy, reqdTy2, fun denv ->
- let reqdTy2Text, actualTyText, _cxs = NicePrint.minimalStringsOfTwoTypes denv reqdTy2 actualTy
- let implicitsText = NicePrint.multiLineStringOfMethInfos infoReader m denv (List.map fst implicits)
- errorR(Error(FSComp.SR.tcAmbiguousImplicitConversion(actualTyText, reqdTy2Text, implicitsText), m))))
+ let reqdTy2Text, actualTyText, _cxs = NicePrint.minimalRichTextsOfTwoTypes denv reqdTy2 actualTy
+ let implicitsText = NicePrint.multiLineRichTextOfMethInfos infoReader m denv (List.map fst implicits)
+ errorR(RichError(FSComp.SR.tcAmbiguousImplicitConversion(actualTyText, reqdTy2Text, implicitsText), m))))
| _ -> None
else
None
@@ -260,16 +260,16 @@ let rec AdjustRequiredTypeForTypeDirectedConversions (infoReader: InfoReader) ad
let g = infoReader.g
let warn info denv =
- let reqdTyText, actualTyText, _cxs = NicePrint.minimalStringsOfTwoTypes denv reqdTy actualTy
+ let reqdTyText, actualTyText, _cxs = NicePrint.minimalRichTextsOfTwoTypes denv reqdTy actualTy
match info with
| TypeDirectedConversion.BuiltIn ->
- Error(FSComp.SR.tcBuiltInImplicitConversionUsed(actualTyText, reqdTyText), m)
+ RichError(FSComp.SR.tcBuiltInImplicitConversionUsed(actualTyText, reqdTyText), m)
| TypeDirectedConversion.Implicit convMeth ->
- let methText = NicePrint.stringOfMethInfo infoReader m denv convMeth
+ let methText = NicePrint.richTextOfMethInfo infoReader m denv convMeth
if isMethodArg then
- Error(FSComp.SR.tcImplicitConversionUsedForMethodArg(methText, actualTyText, reqdTyText), m)
+ RichError(FSComp.SR.tcImplicitConversionUsedForMethodArg(methText, actualTyText, reqdTyText), m)
else
- Error(FSComp.SR.tcImplicitConversionUsedForNonMethodArg(methText, actualTyText, reqdTyText), m)
+ RichError(FSComp.SR.tcImplicitConversionUsedForNonMethodArg(methText, actualTyText, reqdTyText), m)
if isConstraint then
reqdTy, TypeDirectedConversionUsed.No, None
@@ -720,7 +720,7 @@ type CalledMeth<'T>
let names = System.Collections.Generic.HashSet<_>()
for CallerNamedArg(nm, _) in namedCallerArgs do
if not (names.Add nm.idText) then
- errorR(Error(FSComp.SR.typrelNamedArgumentHasBeenAssignedMoreThenOnce nm.idText, m))
+ errorR(RichError(FSComp.SR.typrelNamedArgumentHasBeenAssignedMoreThenOnce (RichText.mkParameter nm.idText), m))
let argSet = { UnnamedCalledArgs=unnamedCalledArgs; UnnamedCallerArgs=unnamedCallerArgs; ParamArrayCalledArgOpt=paramArrayCalledArgOpt; ParamArrayCallerArgs=paramArrayCallerArgs; AssignedNamedArgs=assignedNamedArgs }
@@ -1025,7 +1025,7 @@ let TakeObjAddrForMethodCall g amap (minfo: MethInfo) isMutable m staticTyOpt ob
minfo.TryObjArgByrefType(amap, m, minfo.FormalMethodInst)
|> Option.iter (fun ty ->
if not (isInByrefTy g ty) then
- errorR(Error(FSComp.SR.tcCannotCallExtensionMethodInrefToByref(minfo.DisplayName), m)))
+ errorR(RichError(FSComp.SR.tcCannotCallExtensionMethodInrefToByref(RichText.mkMethod minfo.DisplayName), m)))
wrap, [objArgExprCoerced]
@@ -1197,7 +1197,7 @@ let rec BuildMethodCall tcVal g amap isMutable m isProp minfo valUseFlags minst
// prohibit calls to methods that are declared in specific array types (Get, Set, Address)
// these calls are provided by the runtime and should not be called from the user code
if isArrayTy g enclTy then
- let tpe = TypeProviderError(FSComp.SR.tcRuntimeSuppliedMethodCannotBeUsedInUserCode(minfo.DisplayName), providedMeth.TypeProviderDesignation, m)
+ let tpe = TypeProviderError(FSComp.SR.tcRuntimeSuppliedMethodCannotBeUsedInUserCode(RichText.mkMethod minfo.DisplayName), providedMeth.TypeProviderDesignation, m)
error tpe
let isStruct = isStructTy g enclTy
let isCtor = minfo.IsConstructor
@@ -1270,7 +1270,7 @@ let rec BuildMethodCall tcVal g amap isMutable m isProp minfo valUseFlags minst
let ILFieldStaticChecks g amap infoReader ad m (finfo : ILFieldInfo) =
CheckILFieldInfoAccessible g amap m ad finfo
- if not finfo.IsStatic then error (Error (FSComp.SR.tcFieldIsNotStatic(finfo.FieldName), m))
+ if not finfo.IsStatic then error (RichError(FSComp.SR.tcFieldIsNotStatic(RichText.mkField finfo.FieldName), m))
// Static IL interfaces fields are not supported in lower F# versions.
if isInterfaceTy g finfo.ApparentEnclosingType then
@@ -1287,9 +1287,9 @@ let ILFieldInstanceChecks g amap ad m (finfo : ILFieldInfo) =
let MethInfoChecks g amap isInstance tyargsOpt objArgs ad m (minfo: MethInfo) =
if minfo.IsInstance <> isInstance then
if isInstance then
- error (Error (FSComp.SR.csMethodIsNotAnInstanceMethod(minfo.LogicalName), m))
+ error (RichError(FSComp.SR.csMethodIsNotAnInstanceMethod(RichText.mkMethod minfo.LogicalName), m))
else
- error (Error (FSComp.SR.csMethodIsNotAStaticMethod(minfo.LogicalName), m))
+ error (RichError(FSComp.SR.csMethodIsNotAStaticMethod(RichText.mkMethod minfo.LogicalName), m))
// keep the original accessibility domain to determine type accessibility
let adOriginal = ad
@@ -1310,7 +1310,7 @@ let MethInfoChecks g amap isInstance tyargsOpt objArgs ad m (minfo: MethInfo) =
| _ -> ad
if not (minfo.IsProtectedAccessibility && minfo.LogicalName.StartsWithOrdinal("set_")) && not(IsTypeAndMethInfoAccessible amap m adOriginal ad minfo) then
- error (Error (FSComp.SR.tcMethodNotAccessible(minfo.LogicalName), m))
+ error (RichError(FSComp.SR.tcMethodNotAccessible(RichText.mkMethod minfo.LogicalName), m))
if isAnyTupleTy g minfo.ApparentEnclosingType && not minfo.IsExtensionMember &&
(minfo.LogicalName.StartsWithOrdinal("get_Item") || minfo.LogicalName.StartsWithOrdinal("get_Rest")) then
@@ -1749,7 +1749,7 @@ let AdjustCallerArgs tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader
match objArgs, lambdaVars with
| [objArg], Some _ ->
if calledMethInfo.IsExtensionMember && calledMethInfo.ObjArgNeedsAddress(amap, mMethExpr) then
- error(Error(FSComp.SR.tcCannotPartiallyApplyExtensionMethodForByref(calledMethInfo.DisplayName), mMethExpr))
+ error(RichError(FSComp.SR.tcCannotPartiallyApplyExtensionMethodForByref(RichText.mkMethod calledMethInfo.DisplayName), mMethExpr))
let objArgTy = tyOfExpr g objArg
let v, ve = mkCompGenLocal mMethExpr "objectArg" objArgTy
(fun body -> mkCompGenLet mMethExpr v objArg body), [ve]
@@ -1816,7 +1816,7 @@ module ProvidedMethodCalls =
let ty = ImportProvidedType amap m objTy
let normTy = normalizeEnumTy g ty
obj.PUntaint((fun v ->
- let fail() = raise (TypeProviderError(FSComp.SR.etUnsupportedConstantType(v.GetType().ToString()), constant.TypeProviderDesignation, m))
+ let fail() = raise (TypeProviderError(FSComp.SR.etUnsupportedConstantType(RichText.mkText (v.GetType().ToString())), constant.TypeProviderDesignation, m))
try
if isNull v then mkNull m ty else
let c =
@@ -1916,9 +1916,9 @@ module ProvidedMethodCalls =
dict
let rec exprToExprAndWitness top (ea: Tainted<(ProvidedExpr | null)>) =
- let fail() = error(Error(FSComp.SR.etUnsupportedProvidedExpression(ea.PUntaint((fun etree -> match etree with null -> "" | e -> e.UnderlyingExpressionString), m)), m))
+ let fail() = error(RichError(FSComp.SR.etUnsupportedProvidedExpression(RichText.mkText (ea.PUntaint((fun etree -> match etree with null -> "" | e -> e.UnderlyingExpressionString), m))), m))
match ea with
- | Tainted.Null -> error(Error(FSComp.SR.etNullProvidedExpression(ea.TypeProviderDesignation), m))
+ | Tainted.Null -> error(RichError(FSComp.SR.etNullProvidedExpression(RichText.mkText ea.TypeProviderDesignation), m))
| Tainted.NonNull ea ->
let exprType = ea.PApplyOption((fun x -> x.GetExprType()), m)
let exprType = match exprType with | Some exprType -> exprType | None -> fail()
@@ -2109,7 +2109,7 @@ module ProvidedMethodCalls =
| true, v -> v
| _ ->
let typeProviderDesignation = DisplayNameOfTypeProvider (pe.TypeProvider, m)
- error(Error(FSComp.SR.etIncorrectParameterExpression(typeProviderDesignation, vRaw.Name), m))
+ error(RichError(FSComp.SR.etIncorrectParameterExpression(RichText.mkText typeProviderDesignation, RichText.mkParameter vRaw.Name), m))
and exprToExpr expr =
let _, (resExpr, _) = exprToExprAndWitness false expr
diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs
index 125bed2fdb8..5856264788a 100644
--- a/src/Compiler/Checking/MethodOverrides.fs
+++ b/src/Compiler/Checking/MethodOverrides.fs
@@ -115,31 +115,23 @@ exception OverrideDoesntOverride of DisplayEnv * OverrideInfo * MethInfo option
module DispatchSlotChecking =
/// Print the signature of an override to a buffer as part of an error message
- let PrintOverrideToBuffer denv os (Override(_, _, id, methTypars, memberToParentInst, argTys, retTy, _, _, _)) =
+ let FormatOverride denv (Override(_, _, id, methTypars, memberToParentInst, argTys, retTy, _, _, _)) =
let denv = { denv with showTyparBinding = true }
let retTy = (retTy |> GetFSharpViewOfReturnType denv.g)
let argInfos =
match argTys with
| [] -> [[(denv.g.unit_ty, ValReprInfo.unnamedTopArg1)]]
| _ -> argTys |> List.mapSquared (fun ty -> (ty, ValReprInfo.unnamedTopArg1))
- LayoutRender.bufferL os (NicePrint.prettyLayoutOfMemberSig denv (memberToParentInst, id.idText, methTypars, argInfos, retTy))
+ LayoutRender.toRichText (NicePrint.prettyLayoutOfMemberSig denv (memberToParentInst, id.idText, methTypars, argInfos, retTy))
- /// Print the signature of a MethInfo to a buffer as part of an error message
- let PrintMethInfoSigToBuffer g amap m denv os minfo =
+ /// Format the signature of a MethInfo as part of an error message
+ let FormatMethInfoSig g amap m denv minfo =
let denv = { denv with showTyparBinding = true }
let (CompiledSig(argTys, retTy, fmethTypars, ttpinst)) = CompiledSigOfMeth g amap m minfo
let retTy = (retTy |> GetFSharpViewOfReturnType g)
let argInfos = argTys |> List.mapSquared (fun ty -> (ty, ValReprInfo.unnamedTopArg1))
let nm = minfo.LogicalName
- LayoutRender.bufferL os (NicePrint.prettyLayoutOfMemberSig denv (ttpinst, nm, fmethTypars, argInfos, retTy))
-
- /// Format the signature of an override as a string as part of an error message
- let FormatOverride denv d =
- buildString (fun buf -> PrintOverrideToBuffer denv buf d)
-
- /// Format the signature of a MethInfo as a string as part of an error message
- let FormatMethInfoSig g amap m denv d =
- buildString (fun buf -> PrintMethInfoSigToBuffer g amap m denv buf d)
+ LayoutRender.toRichText (NicePrint.prettyLayoutOfMemberSig denv (ttpinst, nm, fmethTypars, argInfos, retTy))
/// Get the override info for an existing (inherited) method being used to implement a dispatch slot.
let GetInheritedMemberOverrideInfo g amap m parentType (minfo: MethInfo) =
@@ -391,13 +383,13 @@ module DispatchSlotChecking =
checkLanguageFeatureAndRecover g.langVersion LanguageFeature.DefaultInterfaceMemberConsumption m
if reqdSlot.PossiblyNoMostSpecificImplementation then
- errorR(Error(FSComp.SR.typrelInterfaceMemberNoMostSpecificImplementation(NicePrint.stringOfMethInfo infoReader m denv dispatchSlot), m))
+ errorR(RichError(FSComp.SR.typrelInterfaceMemberNoMostSpecificImplementation(NicePrint.richTextOfMethInfo infoReader m denv dispatchSlot), m))
// error reporting path
let compiledSig = CompiledSigOfMeth g amap m dispatchSlot
let noimpl() =
- missingOverloadImplementation.Add((isReqdTyInterface, lazy NicePrint.stringOfMethInfo infoReader m denv dispatchSlot))
+ missingOverloadImplementation.Add((isReqdTyInterface, lazy NicePrint.richTextOfMethInfo infoReader m denv dispatchSlot))
match overrides |> List.filter (IsPartialMatch g dispatchSlot compiledSig) with
| [] ->
@@ -425,15 +417,15 @@ module DispatchSlotChecking =
noimpl()
elif (argTys.Length <> vargTys.Length) then
- fail(Error(FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfArguments(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
+ fail(RichError(FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfArguments(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
elif methTypars.Length <> fvmethTypars.Length then
- fail(Error(FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfTypeParameters(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
+ fail(RichError(FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfTypeParameters(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
elif not (IsTyparKindMatch compiledSig overrideBy) then
- fail(Error(FSComp.SR.typrelMemberDoesNotHaveCorrectKindsOfGenericParameters(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
+ fail(RichError(FSComp.SR.typrelMemberDoesNotHaveCorrectKindsOfGenericParameters(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
else
- fail(Error(FSComp.SR.typrelMemberCannotImplement(FormatOverride denv overrideBy, NicePrint.stringOfMethInfo infoReader m denv dispatchSlot, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
+ fail(RichError(FSComp.SR.typrelMemberCannotImplement(FormatOverride denv overrideBy, NicePrint.richTextOfMethInfo infoReader m denv dispatchSlot, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
| overrideBy :: _ ->
- errorR(Error(FSComp.SR.typrelOverloadNotFound(FormatMethInfoSig g amap m denv dispatchSlot, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
+ errorR(RichError(FSComp.SR.typrelOverloadNotFound(FormatMethInfoSig g amap m denv dispatchSlot, FormatMethInfoSig g amap m denv dispatchSlot), overrideBy.Range))
| [ overrideBy ] ->
if dispatchSlots |> List.exists (fun reqdSlot -> OverrideImplementsDispatchSlot g amap m reqdSlot.MethodInfo overrideBy) then
@@ -442,8 +434,8 @@ module DispatchSlotChecking =
// Error will be reported below in CheckOverridesAreAllUsedOnce
()
| ambiguousOverride :: _ ->
- fail(Error(FSComp.SR.typrelOverrideWasAmbiguous(FormatMethInfoSig g amap ambiguousOverride.Range denv dispatchSlot), ambiguousOverride.Range))
- | _ -> fail(Error(FSComp.SR.typrelMoreThenOneOverride(FormatMethInfoSig g amap m denv dispatchSlot), m))
+ fail(RichError(FSComp.SR.typrelOverrideWasAmbiguous(FormatMethInfoSig g amap ambiguousOverride.Range denv dispatchSlot), ambiguousOverride.Range))
+ | _ -> fail(RichError(FSComp.SR.typrelMoreThenOneOverride(FormatMethInfoSig g amap m denv dispatchSlot), m))
if missingOverloadImplementation.Count > 0 then
// compose message listing missing override implementation
@@ -459,24 +451,30 @@ module DispatchSlotChecking =
// only one missing override, we have specific message for that
let signature = (snd missingOverloadImplementation[0]).Value
if messageWithInterfaceSuggestion then
- fail(Error(FSComp.SR.typrelNoImplementationGivenWithSuggestion(signature), m))
+ fail(RichError(FSComp.SR.typrelNoImplementationGivenWithSuggestion(signature), m))
else
- fail(Error(FSComp.SR.typrelNoImplementationGiven(signature), m))
+ fail(RichError(FSComp.SR.typrelNoImplementationGiven(signature), m))
else
let signatures =
- (missingOverloadImplementation
- |> Seq.truncate maxDisplayedOverrides
- |> Seq.map (snd >> fun signature -> System.Environment.NewLine + "\t'" + signature.Value + "'")
- |> String.concat "") + System.Environment.NewLine
+ let listed =
+ missingOverloadImplementation
+ |> Seq.truncate maxDisplayedOverrides
+ |> Seq.map (fun (_, signature) ->
+ RichText.concat
+ [ RichText.mkText (System.Environment.NewLine + "\t'")
+ signature.Value
+ RichText.mkText "'" ])
+ |> RichText.concat
+ RichText.append listed (RichText.mkText System.Environment.NewLine)
// we have specific message if the list is truncated
- let messageFunction =
+ let messageFunction: RichText -> int * RichText =
match shouldTruncate, messageWithInterfaceSuggestion with
| false, true -> FSComp.SR.typrelNoImplementationGivenSeveralWithSuggestion
| false, false -> FSComp.SR.typrelNoImplementationGivenSeveral
| true , true -> FSComp.SR.typrelNoImplementationGivenSeveralTruncatedWithSuggestion
| true , false -> FSComp.SR.typrelNoImplementationGivenSeveralTruncated
- fail(Error(messageFunction(signatures), m))
+ fail(RichError(messageFunction(signatures), m))
res
@@ -633,17 +631,19 @@ module DispatchSlotChecking =
| possibleDispatchSlots ->
let details =
possibleDispatchSlots
- |> List.map (fun dispatchSlot -> FormatMethInfoSig g amap m denv dispatchSlot)
- |> Seq.map (sprintf "%s %s" System.Environment.NewLine)
- |> String.concat ""
+ |> List.map (fun dispatchSlot ->
+ RichText.append
+ (RichText.mkText (System.Environment.NewLine + " "))
+ (FormatMethInfoSig g amap m denv dispatchSlot))
+ |> RichText.concat
- errorR(Error(FSComp.SR.typrelMemberHasMultiplePossibleDispatchSlots(FormatOverride denv overrideBy, details), overrideBy.Range))
+ errorR(RichError(FSComp.SR.typrelMemberHasMultiplePossibleDispatchSlots(FormatOverride denv overrideBy, details), overrideBy.Range))
| [matchedSlot] ->
let dispatchSlot = matchedSlot.MethodInfo
if dispatchSlot.IsFinal && (isObjExpr || not (typeEquiv g reqdTy dispatchSlot.ApparentEnclosingType)) then
- errorR(Error(FSComp.SR.typrelMethodIsSealed(NicePrint.stringOfMethInfo infoReader m denv dispatchSlot), m))
+ errorR(RichError(FSComp.SR.typrelMethodIsSealed(NicePrint.richTextOfMethInfo infoReader m denv dispatchSlot), m))
| matchedSlots ->
// Filter out slots that have DIM coverage directly from RequiredSlot
let slotsWithoutDIMCoverage =
@@ -656,14 +656,20 @@ module DispatchSlotChecking =
isInterfaceTy g dispatchSlot.ApparentEnclosingType ||
not (DispatchSlotIsAlreadyImplemented g amap m availPriorOverridesKeyed dispatchSlot)) with
| h1 :: h2 :: _ ->
- errorR(Error(FSComp.SR.typrelOverrideImplementsMoreThenOneSlot((FormatOverride denv overrideBy), (NicePrint.stringOfMethInfo infoReader m denv h1), (NicePrint.stringOfMethInfo infoReader m denv h2)), m))
+ errorR(RichError(FSComp.SR.typrelOverrideImplementsMoreThenOneSlot((FormatOverride denv overrideBy), (NicePrint.richTextOfMethInfo infoReader m denv h1), (NicePrint.richTextOfMethInfo infoReader m denv h2)), m))
| _ ->
// dispatch slots are ordered from the derived classes to base
// so we can check the topmost dispatch slot if it is final
let allMatchedVirts = matchedSlots |> List.map (fun rs -> rs.MethodInfo)
match allMatchedVirts with
- | meth :: _ when meth.IsFinal -> errorR(Error(FSComp.SR.tcCannotOverrideSealedMethod
- (sprintf "%s::%s" (NicePrint.stringOfTy denv meth.ApparentEnclosingType) meth.LogicalName), m))
+ | meth :: _ when meth.IsFinal ->
+ let name =
+ RichText.concat
+ [ NicePrint.richTextOfTy denv meth.ApparentEnclosingType
+ RichText.mkPunctuation "::"
+ RichText.mkMethod meth.LogicalName ]
+
+ errorR(RichError(FSComp.SR.tcCannotOverrideSealedMethod name, m))
| _ -> ()
/// Get the slots of a type that can or must be implemented. This depends
@@ -769,7 +775,7 @@ module DispatchSlotChecking =
let minfo = reqdSlot.MethodInfo
// If the slot is optional, then we do not need an explicit implementation.
minfo.IsNewSlot && not reqdSlot.IsOptional) then
- errorR(Error(FSComp.SR.typrelNeedExplicitImplementation(NicePrint.minimalStringOfType denv ty), reqdTyRange))
+ errorR(RichError(FSComp.SR.typrelNeedExplicitImplementation(NicePrint.minimalRichTextOfType denv ty), reqdTyRange))
// We also collect up the properties. This is used for abstract slot inference when overriding properties
let isRelevantRequiredProperty (x: PropInfo) =
@@ -938,9 +944,9 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader: InfoReader, nenv
then
(* Warn when we're doing this for class types *)
if AugmentTypeDefinitions.TyconIsCandidateForAugmentationWithEquals g tycon then
- warning(Error(FSComp.SR.typrelTypeImplementsIComparableShouldOverrideObjectEquals(tycon.DisplayName), tycon.Range))
+ warning(RichError(FSComp.SR.typrelTypeImplementsIComparableShouldOverrideObjectEquals(richTextOfEntity tycon), tycon.Range))
else
- warning(Error(FSComp.SR.typrelTypeImplementsIComparableDefaultObjectEqualsProvided(tycon.DisplayName), tycon.Range))
+ warning(RichError(FSComp.SR.typrelTypeImplementsIComparableDefaultObjectEqualsProvided(richTextOfEntity tycon), tycon.Range))
AugmentTypeDefinitions.CheckAugmentationAttribs isImplementation g amap tycon
// Check some conditions about generic comparison and hashing. We can only check this condition after we've done the augmentation
@@ -956,13 +962,13 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader: InfoReader, nenv
if (Option.isSome tycon.GeneratedHashAndEqualsWithComparerValues) &&
(hasExplicitObjectGetHashCode || hasExplicitObjectEqualsOverride) then
- errorR(Error(FSComp.SR.typrelExplicitImplementationOfGetHashCodeOrEquals(tycon.DisplayName), m))
+ errorR(RichError(FSComp.SR.typrelExplicitImplementationOfGetHashCodeOrEquals(richTextOfEntity tycon), m))
if not hasExplicitObjectEqualsOverride && hasExplicitObjectGetHashCode then
- warning(Error(FSComp.SR.typrelExplicitImplementationOfGetHashCode(tycon.DisplayName), m))
+ warning(RichError(FSComp.SR.typrelExplicitImplementationOfGetHashCode(richTextOfEntity tycon), m))
if hasExplicitObjectEqualsOverride && not hasExplicitObjectGetHashCode then
- warning(Error(FSComp.SR.typrelExplicitImplementationOfEquals(tycon.DisplayName), m))
+ warning(RichError(FSComp.SR.typrelExplicitImplementationOfEquals(richTextOfEntity tycon), m))
// remember these values to ensure we don't generate these methods during codegen
tcaug.SetHasObjectGetHashCode hasExplicitObjectGetHashCode
diff --git a/src/Compiler/Checking/MethodOverrides.fsi b/src/Compiler/Checking/MethodOverrides.fsi
index 4ad9634be2a..4e32cce5b25 100644
--- a/src/Compiler/Checking/MethodOverrides.fsi
+++ b/src/Compiler/Checking/MethodOverrides.fsi
@@ -83,10 +83,11 @@ exception OverrideDoesntOverride of DisplayEnv * OverrideInfo * MethInfo option
module DispatchSlotChecking =
/// Format the signature of an override as a string as part of an error message
- val FormatOverride: denv: DisplayEnv -> d: OverrideInfo -> string
+ val FormatOverride: denv: DisplayEnv -> d: OverrideInfo -> RichText
/// Format the signature of a MethInfo as a string as part of an error message
- val FormatMethInfoSig: g: TcGlobals -> amap: ImportMap -> m: range -> denv: DisplayEnv -> d: MethInfo -> string
+ val FormatMethInfoSig:
+ g: TcGlobals -> amap: ImportMap -> m: range -> denv: DisplayEnv -> minfo: MethInfo -> RichText
/// Get the override information for an object expression method being used to implement dispatch slots
val GetObjectExprOverrideInfo:
diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs
index 9be3d04e58f..4b6a309159e 100644
--- a/src/Compiler/Checking/NameResolution.fs
+++ b/src/Compiler/Checking/NameResolution.fs
@@ -219,7 +219,7 @@ type Item =
/// CustomOperation(nm, helpText, methInfo)
///
/// Used to indicate the availability or resolution of a custom query operation such as 'sortBy' or 'where' in computation expression syntax
- | CustomOperation of string * (unit -> string option) * MethInfo option
+ | CustomOperation of string * (unit -> RichText option) * MethInfo option
/// Represents the resolution of a name to a custom builder in the F# computation expression syntax
| CustomBuilder of string * ValRef
@@ -1010,7 +1010,7 @@ let CheckForDirectReferenceToGeneratedType (tcref: TyconRef, genOk, m) =
match tcref.TypeReprInfo with
| TProvidedTypeRepr info when not info.IsErased ->
if IsGeneratedTypeDirectReference (info.ProvidedType, m) then
- error (Error(FSComp.SR.etDirectReferenceToGeneratedTypeNotAllowed(tcref.DisplayName), m))
+ error (RichError(FSComp.SR.etDirectReferenceToGeneratedTypeNotAllowed(richTextOfEntityRef tcref), m))
| _ -> ()
/// This adds a new entity for a lazily discovered provided type into the TAST structure.
@@ -2603,14 +2603,14 @@ let CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities
// plausible types have different arities
(tcrefs |> Seq.distinctBy (fun (_, tcref) -> tcref.Typars.Length) |> Seq.length > 1) ->
[ for resInfo, tcref in tcrefs do
- let resInfo = resInfo.AddWarning (fun _typarChecker -> errorR(Error(FSComp.SR.nrTypeInstantiationNeededToDisambiguateTypesWithSameName(tcref.DisplayName, tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m)))
+ let resInfo = resInfo.AddWarning (fun _typarChecker -> errorR(RichError(FSComp.SR.nrTypeInstantiationNeededToDisambiguateTypesWithSameName(richTextOfEntityRef tcref, richTextOfEntityRefName tcref tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m)))
yield (resInfo, tcref) ]
| [(resInfo, tcref)] when typeNameResInfo.StaticArgsInfo.HasNoStaticArgsInfo && ((tcref.Typars).Length - resInfo.EnclosingTypeInst.Length) > 0 && typeNameResInfo.ResolutionFlag = ResolveTypeNamesToTypeRefs ->
let resInfo =
resInfo.AddWarning (fun (ResultTyparChecker typarChecker) ->
if not (typarChecker()) then
- warning(Error(FSComp.SR.nrTypeInstantiationIsMissingAndCouldNotBeInferred(tcref.DisplayName, tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m)))
+ warning(RichError(FSComp.SR.nrTypeInstantiationIsMissingAndCouldNotBeInferred(richTextOfEntityRef tcref, richTextOfEntityRefName tcref tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m)))
[(resInfo, tcref)]
| _ ->
@@ -3056,14 +3056,16 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf
|> Array.sort
|> Array.map (fun s -> $" %s{s}")
|> fun a -> System.String.Join("\n", a)
+ let message =
+ FSComp.SR.tcMultipleRecdTypeChoice(RichText.mkText candidates, richTextOfEntityRefName tcref resolvedTypeName, RichText.mkText overlappingNames)
if g.langVersion.SupportsFeature(LanguageFeature.WarningWhenMultipleRecdTypeChoice) then
- warning(Error(FSComp.SR.tcMultipleRecdTypeChoice(candidates, resolvedTypeName, overlappingNames), m))
+ warning(RichError(message, m))
else
- informationalWarning(Error(FSComp.SR.tcMultipleRecdTypeChoice(candidates, resolvedTypeName, overlappingNames), m))
+ informationalWarning(RichError(message, m))
| _ -> ()
- FSComp.SR.undefinedNameFieldConstructorOrMemberWhenTypeIsKnown(tcref.DisplayNameWithStaticParametersAndUnderscoreTypars, s)
+ FSComp.SR.undefinedNameFieldConstructorOrMemberWhenTypeIsKnown(richTextOfEntityRefName tcref tcref.DisplayNameWithStaticParametersAndUnderscoreTypars, s)
| ValueSome tcref ->
- FSComp.SR.undefinedNameFieldConstructorOrMemberWhenTypeIsKnown(tcref.DisplayNameWithStaticParametersAndUnderscoreTypars, s)
+ FSComp.SR.undefinedNameFieldConstructorOrMemberWhenTypeIsKnown(richTextOfEntityRefName tcref tcref.DisplayNameWithStaticParametersAndUnderscoreTypars, s)
| _ ->
FSComp.SR.undefinedNameFieldConstructorOrMember(s)
@@ -3481,7 +3483,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified
let ResolveExprLongIdent sink (ncenv: NameResolver) m ad nenv typeNameResInfo lid maybeAppliedArgExpr =
match lid with
- | [] -> raze (Error(FSComp.SR.nrInvalidExpression(textOfLid lid), m))
+ | [] -> raze (RichError(FSComp.SR.nrInvalidExpression(RichText.mkText (textOfLid lid)), m))
| id :: rest -> ResolveExprLongIdentPrim sink ncenv true OpenQualified m ad nenv typeNameResInfo id rest false maybeAppliedArgExpr
//-------------------------------------------------------------------------
@@ -3745,7 +3747,7 @@ let SuggestTypeLongIdentInModuleOrNamespace depth (modref: ModuleOrNamespaceRef)
if IsEntityAccessible amap m ad (modref.NestedTyconRef e) then
addToBuffer e.DisplayName
- let errorTextF s = FSComp.SR.undefinedNameTypeIn(s, fullDisplayTextOfModRef modref)
+ let errorTextF s = FSComp.SR.undefinedNameTypeIn(s, richTextOfQualifiedModRef modref)
UndefinedName(depth, errorTextF, id, suggestPossibleTypes)
/// Resolve a long identifier representing a type in a module or namespace
@@ -4046,8 +4048,8 @@ let ResolveFieldPrim sink (ncenv: NameResolver) nenv ad ty (mp, id: Ident) allFi
for label in SuggestOtherLabelsOfSameRecordType g nenv ty id allFields do
addToBuffer label
- let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty
- let errorText = FSComp.SR.nrRecordDoesNotContainSuchLabel(typeName, id.idText)
+ let typeName = NicePrint.minimalRichTextOfType nenv.eDisplayEnv ty
+ let errorText = FSComp.SR.nrRecordDoesNotContainSuchLabel(typeName, RichText.mkUnresolvedName id.idText)
error(ErrorWithSuggestions(errorText, m, id.idText, suggestLabels))
else
lookup()
@@ -4112,7 +4114,7 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid =
| ValueSome (anonInfo, tys) ->
match anonInfo.SortedNames |> Array.tryFindIndex (fun x -> x = id.idText) with
| Some index -> OneSuccess (Item.AnonRecdField (anonInfo, tys, index, m))
- | _ -> raze (Error(FSComp.SR.nrRecordDoesNotContainSuchLabel(NicePrint.minimalStringOfType nenv.eDisplayEnv ty, id.idText), m))
+ | _ -> raze (RichError(FSComp.SR.nrRecordDoesNotContainSuchLabel(NicePrint.minimalRichTextOfType nenv.eDisplayEnv ty, RichText.mkUnresolvedName id.idText), m))
| _ ->
let otherRecordFields ty =
let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty
@@ -4133,8 +4135,8 @@ let ResolveNestedField sink (ncenv: NameResolver) nenv ad recdTy lid =
for label in SuggestOtherLabelsOfSameRecordType g nenv ty id (otherRecordFields ty) do
addToBuffer label
- let typeName = NicePrint.minimalStringOfType nenv.eDisplayEnv ty
- let errorText = FSComp.SR.nrRecordDoesNotContainSuchLabel(typeName,id.idText)
+ let typeName = NicePrint.minimalRichTextOfType nenv.eDisplayEnv ty
+ let errorText = FSComp.SR.nrRecordDoesNotContainSuchLabel(typeName, RichText.mkUnresolvedName id.idText)
raze (ErrorWithSuggestions(errorText, m, id.idText, suggestLabels))
else
match Map.tryFind id.idText nenv.eFieldLabels with
@@ -4345,7 +4347,7 @@ let ResolveLongIdentAsExprAndComputeRange (sink: TcResultsSink) (ncenv: NameReso
match item1, item with
| Item.MethodGroup(name, minfos1, _), Item.MethodGroup(_, [], _) when not (isNil minfos1) ->
- raze(Error(FSComp.SR.methodIsNotStatic name, wholem))
+ raze(RichError(FSComp.SR.methodIsNotStatic (RichText.mkMethod name), wholem))
| _ ->
// Fake idents e.g. 'Microsoft.FSharp.Core.None' have identical ranges for each part
diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi
index 79d1dfbdb49..4068b901a6c 100755
--- a/src/Compiler/Checking/NameResolution.fsi
+++ b/src/Compiler/Checking/NameResolution.fsi
@@ -106,7 +106,7 @@ type Item =
/// CustomOperation(nm, helpText, methInfo)
///
/// Used to indicate the availability or resolution of a custom query operation such as 'sortBy' or 'where' in computation expression syntax
- | CustomOperation of string * (unit -> string option) * MethInfo option
+ | CustomOperation of string * (unit -> RichText option) * MethInfo option
/// Represents the resolution of a name to a custom builder in the F# computation expression syntax
| CustomBuilder of string * ValRef
diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs
index 91751d5c8e5..12e33dce83f 100644
--- a/src/Compiler/Checking/NicePrint.fs
+++ b/src/Compiler/Checking/NicePrint.fs
@@ -1510,21 +1510,8 @@ module PrintTastMemberOrVals =
let argInfos, retTy = GetTopTauTypeInFSharpForm denv.g valReprInfo.ArgInfos tau v.Range
let nameL =
- let tagF =
- if isForallFunctionTy denv.g v.Type && not (isDiscard v.DisplayNameCore) then
- if IsOperatorDisplayName v.DisplayName then
- tagOperator
- else
- tagFunction
- elif not v.IsCompiledAsTopLevel && not(isDiscard v.DisplayNameCore) then
- tagLocal
- elif v.IsModuleBinding then
- tagModuleBinding
- else
- tagUnknownEntity
-
v.DisplayName
- |> tagF
+ |> tagValName denv.g v
|> mkNav v.DefinitionRange
|> wordL
let nameL = layoutAccessibility denv v.Accessibility nameL
@@ -2873,7 +2860,9 @@ let dataExprL denv expr = PrintData.dataExprL denv expr
let outputValOrMember denv infoReader os x = x |> PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv infoReader |> bufferL os
-let stringValOrMember denv infoReader x = x |> PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv infoReader |> showL
+let richTextValOrMember denv infoReader x = x |> PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst denv infoReader |> toRichText
+
+let stringValOrMember denv infoReader x = (richTextValOrMember denv infoReader x).Text
/// Print members with a qualification showing the type they are contained in
let layoutQualifiedValOrMember denv infoReader typarInst vref =
@@ -2885,8 +2874,10 @@ let outputQualifiedValOrMember denv infoReader os vref =
let outputQualifiedValSpec denv infoReader os vref =
outputQualifiedValOrMember denv infoReader os vref
-let stringOfQualifiedValOrMember denv infoReader vref =
- PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst { denv with showMemberContainers=true; } infoReader vref |> showL
+let richTextOfQualifiedValOrMember denv infoReader vref =
+ PrintTastMemberOrVals.prettyLayoutOfValOrMemberNoInst { denv with showMemberContainers=true; } infoReader vref |> toRichText
+
+let stringOfQualifiedValOrMember denv infoReader vref = (richTextOfQualifiedValOrMember denv infoReader vref).Text
/// Convert a MethInfo to a string
let formatMethInfoToBufferFreeStyle infoReader m denv buf d =
@@ -2899,26 +2890,43 @@ let prettyLayoutOfMethInfoFreeStyle infoReader m denv typarInst minfo =
let prettyLayoutOfPropInfoFreeStyle g amap m denv d =
InfoMemberPrinting.prettyLayoutOfPropInfoFreeStyle g amap m denv d
+/// Convert a MethInfo to rich text
+let richTextOfMethInfo infoReader m denv minfo =
+ InfoMemberPrinting.prettyLayoutOfMethInfoFreeStyle InfoMemberPrinting.CSharpExtensionTypeDisplay.ReceiverType infoReader m denv emptyTyparInst minfo
+ |> snd
+ |> toRichText
+
/// Convert a MethInfo to a string
-let stringOfMethInfo infoReader m denv minfo =
- buildString (fun buf -> InfoMemberPrinting.formatMethInfoToBufferFreeStyle InfoMemberPrinting.CSharpExtensionTypeDisplay.ReceiverType infoReader m denv buf minfo)
+let stringOfMethInfo infoReader m denv minfo = (richTextOfMethInfo infoReader m denv minfo).Text
/// Convert a MethInfo to a string, suitable for the "Available overloads" list
/// in overload-resolution error messages. For C#-style extension methods, the
/// rendering uses the extension's declaring type rather than the receiver type,
/// so the message is not misleading (issue dotnet/fsharp#9838).
-let stringOfMethInfoForOverloadError infoReader m denv minfo =
- buildString (fun buf -> InfoMemberPrinting.formatMethInfoToBufferFreeStyle InfoMemberPrinting.CSharpExtensionTypeDisplay.DeclaringType infoReader m denv buf minfo)
+let richTextOfMethInfoForOverloadError infoReader m denv minfo =
+ InfoMemberPrinting.prettyLayoutOfMethInfoFreeStyle InfoMemberPrinting.CSharpExtensionTypeDisplay.DeclaringType infoReader m denv emptyTyparInst minfo
+ |> snd
+ |> toRichText
+
+let stringOfMethInfoForOverloadError infoReader m denv minfo = (richTextOfMethInfoForOverloadError infoReader m denv minfo).Text
-let stringOfMethInfoFSharpStyle infoReader m denv minfo =
+let richTextOfMethInfoFSharpStyle infoReader m denv minfo =
InfoMemberPrinting.layoutMethInfoFSharpStyle infoReader m denv minfo
- |> showL
+ |> toRichText
+
+let stringOfMethInfoFSharpStyle infoReader m denv minfo = (richTextOfMethInfoFSharpStyle infoReader m denv minfo).Text
/// Convert MethInfos to lines separated by newline including a newline as the first character
-let multiLineStringOfMethInfos infoReader m denv minfos =
+let multiLineRichTextOfMethInfos infoReader m denv minfos =
minfos
- |> List.map (stringOfMethInfo infoReader m denv >> sprintf "%s %s" Environment.NewLine)
- |> String.concat ""
+ |> List.map (fun minfo ->
+ RichText.append
+ (RichText.mkText (Environment.NewLine + " "))
+ (richTextOfMethInfo infoReader m denv minfo))
+ |> RichText.concat
+
+let multiLineStringOfMethInfos infoReader m denv minfos =
+ (multiLineRichTextOfMethInfos infoReader m denv minfos).Text
let stringOfPropInfo g amap m denv pinfo =
buildString (fun buf -> InfoMemberPrinting.formatPropInfoToBufferFreeStyle g amap m denv buf pinfo)
@@ -2936,7 +2944,9 @@ let layoutOfParamData denv paramData = InfoMemberPrinting.layoutParamData denv p
let layoutExnDef denv infoReader x = x |> TastDefinitionPrinting.layoutExnDefn denv infoReader
-let stringOfTyparConstraints denv x = x |> PrintTypes.layoutConstraintsWithInfo denv SimplifyTypes.typeSimplificationInfo0 |> showL
+let richTextOfTyparConstraints denv x = x |> PrintTypes.layoutConstraintsWithInfo denv SimplifyTypes.typeSimplificationInfo0 |> toRichText
+
+let stringOfTyparConstraints denv x = (richTextOfTyparConstraints denv x).Text
let layoutTyconDefn denv infoReader ad m (* width *) x = TastDefinitionPrinting.layoutTyconDefn denv infoReader ad m true true (mkLocalEntityRef x) (* |> Display.squashTo width *)
@@ -2949,9 +2959,13 @@ let isGeneratedUnionCaseField pos f = TastDefinitionPrinting.isGeneratedUnionCas
let isGeneratedExceptionField pos f = TastDefinitionPrinting.isGeneratedExceptionField pos f
+let richTextOfTyparConstraint denv tpc = richTextOfTyparConstraints denv [tpc]
+
let stringOfTyparConstraint denv tpc = stringOfTyparConstraints denv [tpc]
-let stringOfTy denv x = x |> PrintTypes.layoutType denv |> showL
+let richTextOfTy denv x = x |> PrintTypes.layoutType denv |> toRichText
+
+let stringOfTy denv x = (richTextOfTy denv x).Text
let prettyLayoutOfType denv x = x |> PrintTypes.prettyLayoutOfType denv
@@ -2961,15 +2975,26 @@ let prettyLayoutOfTypeNoCx denv x = x |> PrintTypes.prettyLayoutOfTypeNoConstrai
let prettyLayoutOfTypar denv x = x |> PrintTypes.layoutTyparRef denv
-let prettyStringOfTy denv x = x |> PrintTypes.prettyLayoutOfType denv |> showL
+let prettyRichTextOfTy denv x = x |> PrintTypes.prettyLayoutOfType denv |> toRichText
+
+let prettyStringOfTy denv x = (prettyRichTextOfTy denv x).Text
let prettyStringOfTyNoCx denv x = x |> PrintTypes.prettyLayoutOfTypeNoConstraints denv |> showL
-let stringOfRecdField denv infoReader enclosingTcref x = x |> TastDefinitionPrinting.layoutRecdField id false denv infoReader enclosingTcref |> showL
+let richTextOfRecdField denv infoReader enclosingTcref x =
+ x |> TastDefinitionPrinting.layoutRecdField id false denv infoReader enclosingTcref |> toRichText
+
+let stringOfRecdField denv infoReader enclosingTcref x = (richTextOfRecdField denv infoReader enclosingTcref x).Text
+
+let richTextOfUnionCase denv infoReader enclosingTcref x =
+ x |> TastDefinitionPrinting.layoutUnionCase denv infoReader WordL.bar enclosingTcref |> toRichText
-let stringOfUnionCase denv infoReader enclosingTcref x = x |> TastDefinitionPrinting.layoutUnionCase denv infoReader WordL.bar enclosingTcref |> showL
+let stringOfUnionCase denv infoReader enclosingTcref x = (richTextOfUnionCase denv infoReader enclosingTcref x).Text
-let stringOfExnDef denv infoReader x = x |> TastDefinitionPrinting.layoutExnDefn denv infoReader |> showL
+let richTextOfExnDef denv infoReader x =
+ x |> TastDefinitionPrinting.layoutExnDefn denv infoReader |> toRichText
+
+let stringOfExnDef denv infoReader x = (richTextOfExnDef denv infoReader x).Text
let stringOfFSAttrib denv x = x |> PrintTypes.layoutAttrib denv |> squareAngleL |> showL
@@ -2996,7 +3021,7 @@ let prettyLayoutOfInstAndSig denv x = PrintTypes.prettyLayoutOfInstAndSig denv x
///
/// If the output text is different without showing constraints and/or imperative type variable
/// annotations and/or fully qualifying paths then don't show them!
-let minimalStringsOfTwoTypes denv ty1 ty2 =
+let minimalRichTextsOfTwoTypes denv ty1 ty2 =
let (ty1, ty2), tpcs = PrettyTypes.PrettifyTypePair denv.g (ty1, ty2)
let denv = suppressNullnessAnnotations denv
@@ -3004,9 +3029,9 @@ let minimalStringsOfTwoTypes denv ty1 ty2 =
// try denv + no type annotations
let attempt1 =
let denv = { denv with showInferenceTyparAnnotations=false; showStaticallyResolvedTyparAnnotations=false }
- let min1 = stringOfTy denv ty1
- let min2 = stringOfTy denv ty2
- if min1 <> min2 then Some (min1, min2, "") else None
+ let min1 = richTextOfTy denv ty1
+ let min2 = richTextOfTy denv ty2
+ if min1 <> min2 then Some (min1, min2, RichText.empty) else None
match attempt1 with
| Some res -> res
@@ -3015,9 +3040,9 @@ let minimalStringsOfTwoTypes denv ty1 ty2 =
// try denv + no type annotations + show full paths
let attempt2 =
let denv = { denv with showInferenceTyparAnnotations=false; showStaticallyResolvedTyparAnnotations=false }.SetOpenPaths []
- let min1 = stringOfTy denv ty1
- let min2 = stringOfTy denv ty2
- if min1 <> min2 then Some (min1, min2, "") else None
+ let min1 = richTextOfTy denv ty1
+ let min2 = richTextOfTy denv ty2
+ if min1 <> min2 then Some (min1, min2, RichText.empty) else None
match attempt2 with
| Some res -> res
@@ -3025,9 +3050,9 @@ let minimalStringsOfTwoTypes denv ty1 ty2 =
// try denv
let attempt3 =
- let min1 = stringOfTy denv ty1
- let min2 = stringOfTy denv ty2
- if min1 <> min2 then Some (min1, min2, stringOfTyparConstraints denv tpcs) else None
+ let min1 = richTextOfTy denv ty1
+ let min2 = richTextOfTy denv ty2
+ if min1 <> min2 then Some (min1, min2, richTextOfTyparConstraints denv tpcs) else None
match attempt3 with
| Some res -> res
@@ -3037,9 +3062,9 @@ let minimalStringsOfTwoTypes denv ty1 ty2 =
// try denv + show full paths + static parameters
let denv = denv.SetOpenPaths []
let denv = { denv with includeStaticParametersInTypeNames=true }
- let min1 = stringOfTy denv ty1
- let min2 = stringOfTy denv ty2
- if min1 <> min2 then Some (min1, min2, stringOfTyparConstraints denv tpcs) else None
+ let min1 = richTextOfTy denv ty1
+ let min2 = richTextOfTy denv ty2
+ if min1 <> min2 then Some (min1, min2, richTextOfTyparConstraints denv tpcs) else None
match attempt4 with
| Some res -> res
@@ -3050,29 +3075,42 @@ let minimalStringsOfTwoTypes denv ty1 ty2 =
let denv = { denv with includeStaticParametersInTypeNames=true }
let makeName t =
let assemblyName = PrintTypes.layoutAssemblyName denv t |> function | "" -> "" | name -> $" (%s{name})"
- sprintf "%s%s" (stringOfTy denv t) assemblyName
+ RichText.append (richTextOfTy denv t) (RichText.mkText assemblyName)
+
+ (makeName ty1, makeName ty2, richTextOfTyparConstraints denv tpcs)
+
+let minimalStringsOfTwoTypes denv ty1 ty2 =
+ let min1, min2, cxs = minimalRichTextsOfTwoTypes denv ty1 ty2
+ min1.Text, min2.Text, cxs.Text
- (makeName ty1, makeName ty2, stringOfTyparConstraints denv tpcs)
-
// Note: Always show imperative annotations when comparing value signatures
-let minimalStringsOfTwoValues denv infoReader vref1 vref2 =
+let minimalRichTextsOfTwoValues denv infoReader vref1 vref2 =
let denv = suppressNullnessAnnotations denv
let denvMin = { denv with showInferenceTyparAnnotations=true; showStaticallyResolvedTyparAnnotations=false }
- let min1 = buildString (fun buf -> outputQualifiedValOrMember denvMin infoReader buf vref1)
- let min2 = buildString (fun buf -> outputQualifiedValOrMember denvMin infoReader buf vref2)
+ let min1 = richTextOfQualifiedValOrMember denvMin infoReader vref1
+ let min2 = richTextOfQualifiedValOrMember denvMin infoReader vref2
if min1 <> min2 then
(min1, min2)
else
let denvMax = { denv with showInferenceTyparAnnotations=true; showStaticallyResolvedTyparAnnotations=true }
- let max1 = buildString (fun buf -> outputQualifiedValOrMember denvMax infoReader buf vref1)
- let max2 = buildString (fun buf -> outputQualifiedValOrMember denvMax infoReader buf vref2)
+ let max1 = richTextOfQualifiedValOrMember denvMax infoReader vref1
+ let max2 = richTextOfQualifiedValOrMember denvMax infoReader vref2
max1, max2
+
+let minimalStringsOfTwoValues denv infoReader vref1 vref2 =
+ let min1, min2 = minimalRichTextsOfTwoValues denv infoReader vref1 vref2
+ min1.Text, min2.Text
-let minimalStringOfType denv ty =
+let minimalRichTextOfType denv ty =
let ty, _cxs = PrettyTypes.PrettifyType denv.g ty
let denv = suppressNullnessAnnotations denv
let denvMin = { denv with showInferenceTyparAnnotations=false; showStaticallyResolvedTyparAnnotations=false }
- showL (PrintTypes.layoutTypeWithInfoAndPrec denvMin SimplifyTypes.typeSimplificationInfo0 5 ty)
+ toRichText (PrintTypes.layoutTypeWithInfoAndPrec denvMin SimplifyTypes.typeSimplificationInfo0 5 ty)
+
+let minimalStringOfType denv ty = (minimalRichTextOfType denv ty).Text
+
+let minimalRichTextOfTypeWithNullness denv ty =
+ minimalRichTextOfType {denv with showNullnessAnnotations = Some true} ty
-let minimalStringOfTypeWithNullness denv ty =
+let minimalStringOfTypeWithNullness denv ty =
minimalStringOfType {denv with showNullnessAnnotations = Some true} ty
diff --git a/src/Compiler/Checking/NicePrint.fsi b/src/Compiler/Checking/NicePrint.fsi
index ff55f6cbb03..8c30325cd3d 100644
--- a/src/Compiler/Checking/NicePrint.fsi
+++ b/src/Compiler/Checking/NicePrint.fsi
@@ -50,6 +50,8 @@ val dataExprL: denv: DisplayEnv -> expr: Expr -> Layout
val outputValOrMember: denv: DisplayEnv -> infoReader: InfoReader -> os: StringBuilder -> x: ValRef -> unit
+val richTextValOrMember: denv: DisplayEnv -> infoReader: InfoReader -> x: ValRef -> RichText
+
val stringValOrMember: denv: DisplayEnv -> infoReader: InfoReader -> x: ValRef -> string
val layoutQualifiedValOrMember:
@@ -63,6 +65,8 @@ val outputQualifiedValOrMember: denv: DisplayEnv -> infoReader: InfoReader -> os
val outputQualifiedValSpec: denv: DisplayEnv -> infoReader: InfoReader -> os: StringBuilder -> vref: ValRef -> unit
+val richTextOfQualifiedValOrMember: denv: DisplayEnv -> infoReader: InfoReader -> vref: ValRef -> RichText
+
val stringOfQualifiedValOrMember: denv: DisplayEnv -> infoReader: InfoReader -> vref: ValRef -> string
val formatMethInfoToBufferFreeStyle:
@@ -79,18 +83,30 @@ val prettyLayoutOfMethInfoFreeStyle:
val prettyLayoutOfPropInfoFreeStyle:
g: TcGlobals -> amap: ImportMap -> m: range -> denv: DisplayEnv -> d: PropInfo -> Layout
+/// Convert a MethInfo to rich text
+val richTextOfMethInfo: infoReader: InfoReader -> m: range -> denv: DisplayEnv -> minfo: MethInfo -> RichText
+
val stringOfMethInfo: infoReader: InfoReader -> m: range -> denv: DisplayEnv -> minfo: MethInfo -> string
/// Convert a MethInfo to a string, suitable for the "Available overloads" list
/// in overload-resolution error messages. For C#-style extension methods, the
/// rendering uses the extension's declaring type rather than the receiver type,
/// so the message is not misleading (issue dotnet/fsharp#9838).
+val richTextOfMethInfoForOverloadError:
+ infoReader: InfoReader -> m: range -> denv: DisplayEnv -> minfo: MethInfo -> RichText
+
val stringOfMethInfoForOverloadError:
infoReader: InfoReader -> m: range -> denv: DisplayEnv -> minfo: MethInfo -> string
/// Convert a MethInfo to a F# signature
+/// Convert a MethInfo to a F# signature as rich text
+val richTextOfMethInfoFSharpStyle: infoReader: InfoReader -> m: range -> denv: DisplayEnv -> minfo: MethInfo -> RichText
+
val stringOfMethInfoFSharpStyle: infoReader: InfoReader -> m: range -> denv: DisplayEnv -> minfo: MethInfo -> string
+val multiLineRichTextOfMethInfos:
+ infoReader: InfoReader -> m: range -> denv: DisplayEnv -> minfos: MethInfo list -> RichText
+
val multiLineStringOfMethInfos:
infoReader: InfoReader -> m: range -> denv: DisplayEnv -> minfos: MethInfo list -> string
@@ -105,6 +121,8 @@ val layoutOfParamData: denv: DisplayEnv -> paramData: ParamData -> Layout
val layoutExnDef: denv: DisplayEnv -> infoReader: InfoReader -> x: EntityRef -> Layout
+val richTextOfTyparConstraints: denv: DisplayEnv -> x: (Typar * TyparConstraint) list -> RichText
+
val stringOfTyparConstraints: denv: DisplayEnv -> x: (Typar * TyparConstraint) list -> string
val layoutTyconDefn: denv: DisplayEnv -> infoReader: InfoReader -> ad: AccessorDomain -> m: range -> x: Tycon -> Layout
@@ -119,8 +137,12 @@ val isGeneratedUnionCaseField: pos: int -> f: RecdField -> bool
val isGeneratedExceptionField: pos: 'a -> f: RecdField -> bool
+val richTextOfTyparConstraint: denv: DisplayEnv -> Typar * TyparConstraint -> RichText
+
val stringOfTyparConstraint: denv: DisplayEnv -> Typar * TyparConstraint -> string
+val richTextOfTy: denv: DisplayEnv -> x: TType -> RichText
+
val stringOfTy: denv: DisplayEnv -> x: TType -> string
val prettyLayoutOfType: denv: DisplayEnv -> x: TType -> Layout
@@ -131,14 +153,24 @@ val prettyLayoutOfTypeNoCx: denv: DisplayEnv -> x: TType -> Layout
val prettyLayoutOfTypar: denv: DisplayEnv -> x: Typar -> Layout
+val prettyRichTextOfTy: denv: DisplayEnv -> x: TType -> RichText
+
val prettyStringOfTy: denv: DisplayEnv -> x: TType -> string
val prettyStringOfTyNoCx: denv: DisplayEnv -> x: TType -> string
+val richTextOfRecdField:
+ denv: DisplayEnv -> infoReader: InfoReader -> enclosingTcref: TyconRef -> x: RecdField -> RichText
+
val stringOfRecdField: denv: DisplayEnv -> infoReader: InfoReader -> enclosingTcref: TyconRef -> x: RecdField -> string
+val richTextOfUnionCase:
+ denv: DisplayEnv -> infoReader: InfoReader -> enclosingTcref: TyconRef -> x: UnionCase -> RichText
+
val stringOfUnionCase: denv: DisplayEnv -> infoReader: InfoReader -> enclosingTcref: TyconRef -> x: UnionCase -> string
+val richTextOfExnDef: denv: DisplayEnv -> infoReader: InfoReader -> x: EntityRef -> RichText
+
val stringOfExnDef: denv: DisplayEnv -> infoReader: InfoReader -> x: EntityRef -> string
val stringOfFSAttrib: denv: DisplayEnv -> x: Attrib -> string
@@ -174,11 +206,20 @@ val prettyLayoutOfInstAndSig:
TyparInstantiation * TTypes * TType ->
TyparInstantiation * (TTypes * TType) * (Layout list * Layout) * Layout
+val minimalRichTextsOfTwoTypes: denv: DisplayEnv -> ty1: TType -> ty2: TType -> RichText * RichText * RichText
+
val minimalStringsOfTwoTypes: denv: DisplayEnv -> ty1: TType -> ty2: TType -> string * string * string
+val minimalRichTextsOfTwoValues:
+ denv: DisplayEnv -> infoReader: InfoReader -> vref1: ValRef -> vref2: ValRef -> RichText * RichText
+
val minimalStringsOfTwoValues:
denv: DisplayEnv -> infoReader: InfoReader -> vref1: ValRef -> vref2: ValRef -> string * string
+val minimalRichTextOfType: denv: DisplayEnv -> ty: TType -> RichText
+
val minimalStringOfType: denv: DisplayEnv -> ty: TType -> string
+val minimalRichTextOfTypeWithNullness: denv: DisplayEnv -> ty: TType -> RichText
+
val minimalStringOfTypeWithNullness: denv: DisplayEnv -> ty: TType -> string
diff --git a/src/Compiler/Checking/PatternMatchCompilation.fs b/src/Compiler/Checking/PatternMatchCompilation.fs
index e5af41cb481..7f9fd108c67 100644
--- a/src/Compiler/Checking/PatternMatchCompilation.fs
+++ b/src/Compiler/Checking/PatternMatchCompilation.fs
@@ -26,13 +26,13 @@ open type System.MemoryExtensions
/// Exception raised when a pattern match is incomplete.
/// Fields: isComputationExpression * (counterExample * isShownAsFieldPattern) option * range
-exception MatchIncomplete of bool * (string * bool) option * range
+exception MatchIncomplete of bool * (RichText * bool) option * range
/// Wrapper that adds a for-loop hint to an existing MatchIncomplete diagnostic.
exception MatchIncompleteForLoopHint of exn
exception RuleNeverMatched of range
-exception EnumMatchIncomplete of bool * (string * bool) option * range
+exception EnumMatchIncomplete of bool * (RichText * bool) option * range
type ActionOnFailure =
| ThrowIncompleteMatchException
@@ -371,7 +371,7 @@ let ShowCounterExample g denv m refuted =
| (r, eck) :: t ->
((r, eck), t) ||> List.fold (fun (rAcc, eckAcc) (r, eck) ->
CombineRefutations g rAcc r, eckAcc.Combine(eck))
- let text = LayoutRender.showL (NicePrint.dataExprL denv counterExample)
+ let text = LayoutRender.toRichText (NicePrint.dataExprL denv counterExample)
let failingWhenClause = refuted |> List.exists (function RefutedWhenClause -> true | _ -> false)
Some(text, failingWhenClause, enumCoversKnown)
diff --git a/src/Compiler/Checking/PatternMatchCompilation.fsi b/src/Compiler/Checking/PatternMatchCompilation.fsi
index de9ab0fe318..8afdc2992f3 100644
--- a/src/Compiler/Checking/PatternMatchCompilation.fsi
+++ b/src/Compiler/Checking/PatternMatchCompilation.fsi
@@ -73,11 +73,11 @@ val internal CompilePattern:
/// Exception raised when a pattern match is incomplete.
/// Fields: isComputationExpression * (counterExample * isShownAsFieldPattern) option * range
-exception internal MatchIncomplete of bool * (string * bool) option * range
+exception internal MatchIncomplete of bool * (RichText * bool) option * range
/// Wrapper that adds a for-loop hint to an existing MatchIncomplete diagnostic.
exception internal MatchIncompleteForLoopHint of exn
exception internal RuleNeverMatched of range
-exception internal EnumMatchIncomplete of bool * (string * bool) option * range
+exception internal EnumMatchIncomplete of bool * (RichText * bool) option * range
diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs
index 09266946c43..01485622b1e 100644
--- a/src/Compiler/Checking/PostInferenceChecks.fs
+++ b/src/Compiler/Checking/PostInferenceChecks.fs
@@ -322,9 +322,9 @@ let BindVal cenv env (v: Val) =
not v.Range.IsSynthetic then
if v.IsCtorThisVal then
- warning (Error(FSComp.SR.chkUnusedThisVariable v.DisplayName, v.Range))
+ warning (RichError(FSComp.SR.chkUnusedThisVariable (richTextOfValName cenv.g v), v.Range))
else
- warning (Error(FSComp.SR.chkUnusedValue v.DisplayName, v.Range))
+ warning (RichError(FSComp.SR.chkUnusedValue (richTextOfValName cenv.g v), v.Range))
let BindVals cenv env vs = List.iter (BindVal cenv env) vs
@@ -500,7 +500,7 @@ let CheckEscapes cenv allowProtected m syntacticArgs body = (* m is a range suit
// Inner functions are not guaranteed to compile to method with a predictable arity (number of arguments).
// As such, partial applications involving byref arguments could lead to closures containing byrefs.
// For safety, such functions are assumed to have no known arity, and so cannot accept byrefs.
- errorR(Error(FSComp.SR.chkByrefUsedInInvalidWay(v.DisplayName), m))
+ errorR(RichError(FSComp.SR.chkByrefUsedInInvalidWay(richTextOfValName cenv.g v), m))
elif v.IsBaseVal then
errorR(Error(FSComp.SR.chkBaseUsedInInvalidWay(), m))
@@ -525,7 +525,7 @@ let isLessAccessibleWithVisibility (cenv: cenv) itemAccess refAccess =
let thisCompPath = compPathOfCcu cenv.viewCcu
isLessAccessible (itemAccess |> AccessInternalsVisibleToAsInternal thisCompPath cenv.internalsVisibleToPaths) refAccess
-let CheckTypeForAccess (cenv: cenv) env objName valAcc m ty =
+let CheckTypeForAccess (cenv: cenv) env (objName: unit -> RichText) valAcc m ty =
if cenv.reportErrors then
let visitType ty =
@@ -535,11 +535,11 @@ let CheckTypeForAccess (cenv: cenv) env objName valAcc m ty =
| ValueNone -> ()
| ValueSome tcref ->
if isLessAccessibleWithVisibility cenv tcref.Accessibility valAcc then
- errorR(Error(FSComp.SR.chkTypeLessAccessibleThanType(tcref.DisplayName, objName()), m))
+ errorR(RichError(FSComp.SR.chkTypeLessAccessibleThanType(richTextOfEntityRef tcref, objName()), m))
CheckTypeDeep cenv (visitType, None, None, None, None) cenv.g env NoInfo ty
-let WarnOnWrongTypeForAccess (cenv: cenv) env objName valAcc m ty =
+let WarnOnWrongTypeForAccess (cenv: cenv) env (objName: unit -> RichText) valAcc m ty =
if cenv.reportErrors then
let visitType ty =
@@ -549,8 +549,8 @@ let WarnOnWrongTypeForAccess (cenv: cenv) env objName valAcc m ty =
| ValueNone -> ()
| ValueSome tcref ->
if isLessAccessibleWithVisibility cenv tcref.Accessibility valAcc then
- let errorText = FSComp.SR.chkTypeLessAccessibleThanType(tcref.DisplayName, objName()) |> snd
- let warningText = errorText + Environment.NewLine + FSComp.SR.tcTypeAbbreviationsCheckedAtCompileTime()
+ let errorText = FSComp.SR.chkTypeLessAccessibleThanType(richTextOfEntityRef tcref, objName()) |> snd
+ let warningText = RichText.append errorText (RichText.mkText (Environment.NewLine + FSComp.SR.tcTypeAbbreviationsCheckedAtCompileTime()))
warning(ObsoleteDiagnostic(false, None, Some warningText, None, m))
CheckTypeDeep cenv (visitType, None, None, None, None) cenv.g env NoInfo ty
@@ -652,8 +652,8 @@ let CheckInterfaceTypeArgForUnimplementedStaticAbstractMembers (cenv: cenv) m (t
if hasInterfaceConstraint && isInterfaceTy cenv.g typeArg then
match cenv.infoReader.TryFindUnimplementedStaticAbstractMemberOfType m typeArg with
| Some memberName ->
- let interfaceTypeName = NicePrint.minimalStringOfType cenv.denv typeArg
- errorR(Error(FSComp.SR.chkInterfaceWithUnimplementedStaticAbstractMemberUsedAsTypeArgument(interfaceTypeName, memberName), m))
+ let interfaceTypeName = NicePrint.minimalRichTextOfType cenv.denv typeArg
+ errorR(RichError(FSComp.SR.chkInterfaceWithUnimplementedStaticAbstractMemberUsedAsTypeArgument(interfaceTypeName, RichText.mkMember memberName), m))
| None -> ()
/// Check types occurring in the TAST.
@@ -664,7 +664,7 @@ let CheckTypeAux permitByRefLike (cenv: cenv) env m ty onInnerByrefError =
if tp.IsCompilerGenerated then
errorR (Error(FSComp.SR.checkNotSufficientlyGenericBecauseOfScopeAnon(), m))
else
- errorR (Error(FSComp.SR.checkNotSufficientlyGenericBecauseOfScope(tp.DisplayName), m))
+ errorR (RichError(FSComp.SR.checkNotSufficientlyGenericBecauseOfScope(RichText.mkTypeParameter tp.DisplayName), m))
let visitTyconRef (ctx:TypeInstCtx) tcref =
let checkInner() =
@@ -700,7 +700,7 @@ let CheckTypeAux permitByRefLike (cenv: cenv) env m ty onInnerByrefError =
| ValueNone -> ()
| ValueSome tcref2 ->
if isByrefTyconRef cenv.g tcref2 then
- errorR(Error(FSComp.SR.chkNoByrefsOfByrefs(NicePrint.minimalStringOfType cenv.denv ty), m))
+ errorR(RichError(FSComp.SR.chkNoByrefsOfByrefs(NicePrint.minimalRichTextOfType cenv.denv ty), m))
CheckTypesDeep cenv (visitType, None, None, None, None) cenv.g env tinst
// Check for interfaces with unimplemented static abstract members used as type arguments
@@ -809,13 +809,14 @@ let CheckMultipleInterfaceInstantiations cenv (ty:TType) (interfaces:TType list)
| None -> ()
| Some exn -> exn
- let typ1Str = NicePrint.minimalStringOfType cenv.denv ty1
- let typ2Str = NicePrint.minimalStringOfType cenv.denv ty2
+ let typ1Str = NicePrint.minimalRichTextOfType cenv.denv ty1
+ let typ2Str = NicePrint.minimalRichTextOfType cenv.denv ty2
+ let tcRef1Name = richTextOfEntityRefName tcRef1 tcRef1.DisplayNameWithStaticParametersAndUnderscoreTypars
if isObjectExpression then
- Error(FSComp.SR.typrelInterfaceWithConcreteAndVariableObjectExpression(tcRef1.DisplayNameWithStaticParametersAndUnderscoreTypars, typ1Str, typ2Str),m)
+ RichError(FSComp.SR.typrelInterfaceWithConcreteAndVariableObjectExpression(tcRef1Name, typ1Str, typ2Str), m)
else
- let typStr = NicePrint.minimalStringOfType cenv.denv ty
- Error(FSComp.SR.typrelInterfaceWithConcreteAndVariable(typStr, tcRef1.DisplayNameWithStaticParametersAndUnderscoreTypars, typ1Str, typ2Str),m)
+ let typStr = NicePrint.minimalRichTextOfType cenv.denv ty
+ RichError(FSComp.SR.typrelInterfaceWithConcreteAndVariable(typStr, tcRef1Name, typ1Str, typ2Str), m)
| NotEqual ->
match tryLanguageFeatureErrorOption cenv.g.langVersion LanguageFeature.InterfacesWithMultipleGenericInstantiation m with
@@ -847,7 +848,7 @@ and CheckValRef (cenv: cenv) (env: env) v m (ctxt: PermitByRefExpr) =
// ByRefLike-typed values can only occur in permitting ctxts
if ctxt.Disallow && isByrefLikeTy cenv.g m v.Type then
- errorR(Error(FSComp.SR.chkNoByrefAtThisPoint(v.DisplayName), m))
+ errorR(RichError(FSComp.SR.chkNoByrefAtThisPoint(richTextOfValName cenv.g v.Deref), m))
if env.isInAppExpr then
CheckTypePermitAllByrefs cenv env m v.Type // we do checks for byrefs elsewhere
@@ -888,9 +889,9 @@ and CheckValUse (cenv: cenv) (env: env) (vref: ValRef, vFlags, m) (ctxt: PermitB
let isCompGen = vref.IsCompilerGenerated
match isSpanLike, isCompGen with
| true, true -> errorR(Error(FSComp.SR.chkNoSpanLikeValueFromExpression(), m))
- | true, false -> errorR(Error(FSComp.SR.chkNoSpanLikeVariable(vref.DisplayName), m))
+ | true, false -> errorR(RichError(FSComp.SR.chkNoSpanLikeVariable(richTextOfValName g vref.Deref), m))
| false, true -> errorR(Error(FSComp.SR.chkNoByrefAddressOfValueFromExpression(), m))
- | false, false -> errorR(Error(FSComp.SR.chkNoByrefAddressOfLocal(vref.DisplayName), m))
+ | false, false -> errorR(RichError(FSComp.SR.chkNoByrefAddressOfLocal(richTextOfValName g vref.Deref), m))
let isReturnOfStructThis =
ctxt.PermitOnlyReturnable &&
@@ -924,13 +925,13 @@ and CheckForOverAppliedExceptionRaisingPrimitive (cenv: cenv) expr =
match argsl with
| [] | [_] -> ()
| _ :: _ :: _ ->
- warning(Error(FSComp.SR.checkRaiseFamilyFunctionArgumentCount(v.DisplayName, 1, argsl.Length), funcRange))
+ warning(RichError(FSComp.SR.checkRaiseFamilyFunctionArgumentCount(richTextOfValName g v.Deref, 1, argsl.Length), funcRange))
| OptionalCoerce(Expr.Val (v, _, funcRange)) when valRefEq g v g.invalid_arg_vref ->
match argsl with
| [] | [_] | [_; _] -> ()
| _ :: _ :: _ :: _ ->
- warning(Error(FSComp.SR.checkRaiseFamilyFunctionArgumentCount(v.DisplayName, 2, argsl.Length), funcRange))
+ warning(RichError(FSComp.SR.checkRaiseFamilyFunctionArgumentCount(richTextOfValName g v.Deref, 2, argsl.Length), funcRange))
| OptionalCoerce(Expr.Val (failwithfFunc, _, funcRange)) when valRefEq g failwithfFunc g.failwithf_vref ->
match argsl with
@@ -940,7 +941,7 @@ and CheckForOverAppliedExceptionRaisingPrimitive (cenv: cenv) expr =
let expected = n + 1
let actual = List.length xs + 1
if expected < actual then
- warning(Error(FSComp.SR.checkRaiseFamilyFunctionArgumentCount(failwithfFunc.DisplayName, expected, actual), funcRange))
+ warning(RichError(FSComp.SR.checkRaiseFamilyFunctionArgumentCount(richTextOfValName g failwithfFunc.Deref, expected, actual), funcRange))
| None -> ()
| _ -> ()
| _ -> ()
@@ -1094,7 +1095,7 @@ and TryCheckResumableCodeConstructs cenv env expr : bool =
| ResumableEntryMatchExpr g (noneBranchExpr, someVar, someBranchExpr, _rebuild) ->
if not allowed then
- errorR(Error(FSComp.SR.tcInvalidResumableConstruct("__resumableEntry"), expr.Range))
+ errorR(RichError(FSComp.SR.tcInvalidResumableConstruct(RichText.mkFunction "__resumableEntry"), expr.Range))
CheckExprNoByrefs cenv env noneBranchExpr
BindVal cenv env someVar
CheckExprNoByrefs cenv env someBranchExpr
@@ -1102,7 +1103,7 @@ and TryCheckResumableCodeConstructs cenv env expr : bool =
| ResumeAtExpr g pcExpr ->
if not allowed then
- errorR(Error(FSComp.SR.tcInvalidResumableConstruct("__resumeAt"), expr.Range))
+ errorR(RichError(FSComp.SR.tcInvalidResumableConstruct(RichText.mkFunction "__resumeAt"), expr.Range))
CheckExprNoByrefs cenv env pcExpr
true
@@ -1348,7 +1349,7 @@ and CheckFSharpBaseCall cenv env expr (v, f, _fty, tyargs, baseVal, rest, m) =
let g = cenv.g
let memberInfo = Option.get v.MemberInfo
if memberInfo.MemberFlags.IsDispatchSlot then
- errorR(Error(FSComp.SR.tcCannotCallAbstractBaseMember(v.DisplayName), m))
+ errorR(RichError(FSComp.SR.tcCannotCallAbstractBaseMember(richTextOfValName g v.Deref), m))
NoLimit
else
let env = { env with isInAppExpr = true }
@@ -1372,7 +1373,7 @@ and CheckILBaseCall cenv env (ilMethRef, enclTypeInst, methInst, retTypes, tyarg
resolveILMethodRefWithRescope (rescopeILType scoref) tcref.ILTyconRawMetadata ilMethRef
if mdef.IsAbstract then
- errorR(Error(FSComp.SR.tcCannotCallAbstractBaseMember(mdef.Name), m))
+ errorR(RichError(FSComp.SR.tcCannotCallAbstractBaseMember(RichText.mkMethod mdef.Name), m))
with _ -> ()
| _ -> ()
@@ -1496,7 +1497,7 @@ and CheckNoResumableStmtConstructs cenv _env expr =
when valRefEq g v g.cgh__resumeAt_vref ||
valRefEq g v g.cgh__resumableEntry_vref ||
valRefEq g v g.cgh__stateMachine_vref ->
- errorR(Error(FSComp.SR.tcInvalidResumableConstruct(v.DisplayName), m))
+ errorR(RichError(FSComp.SR.tcInvalidResumableConstruct(richTextOfValName g v.Deref), m))
| _ -> ()
and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr =
@@ -1602,7 +1603,7 @@ and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr =
if cenv.reportErrors then
if ctxt.Disallow then
- errorR(Error(FSComp.SR.chkNoAddressOfAtThisPoint(vref.DisplayName), m))
+ errorR(RichError(FSComp.SR.chkNoAddressOfAtThisPoint(richTextOfValName g vref.Deref), m))
let returningAddrOfLocal =
ctxt.PermitOnlyReturnable &&
@@ -1613,7 +1614,7 @@ and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr =
if vref.IsCompilerGenerated then
errorR(Error(FSComp.SR.chkNoByrefAddressOfValueFromExpression(), m))
else
- errorR(Error(FSComp.SR.chkNoByrefAddressOfLocal(vref.DisplayName), m))
+ errorR(RichError(FSComp.SR.chkNoByrefAddressOfLocal(richTextOfValName g vref.Deref), m))
limit
@@ -1622,7 +1623,7 @@ and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr =
let isVrefLimited = not (HasLimitFlag LimitFlags.ByRefOfStackReferringSpanLike limit)
let isArgLimited = HasLimitFlag LimitFlags.StackReferringSpanLike (CheckExprPermitByRefLike cenv env arg)
if isVrefLimited && isArgLimited then
- errorR(Error(FSComp.SR.chkNoWriteToLimitedSpan(vref.DisplayName), m))
+ errorR(RichError(FSComp.SR.chkNoWriteToLimitedSpan(richTextOfValName g vref.Deref), m))
NoLimit
| TOp.LValueOp (LByrefGet, vref), _, [] ->
@@ -1633,7 +1634,7 @@ and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr =
if vref.IsCompilerGenerated then
errorR(Error(FSComp.SR.chkNoSpanLikeValueFromExpression(), m))
else
- errorR(Error(FSComp.SR.chkNoSpanLikeVariable(vref.DisplayName), m))
+ errorR(RichError(FSComp.SR.chkNoSpanLikeVariable(richTextOfValName g vref.Deref), m))
{ scope = 1; flags = LimitFlags.StackReferringSpanLike }
elif HasLimitFlag LimitFlags.ByRefOfSpanLike limit then
@@ -1645,7 +1646,7 @@ and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr =
let isVrefLimited = not (HasLimitFlag LimitFlags.StackReferringSpanLike (GetLimitVal cenv env m vref.Deref))
let isArgLimited = HasLimitFlag LimitFlags.StackReferringSpanLike (CheckExprPermitByRefLike cenv env arg)
if isVrefLimited && isArgLimited then
- errorR(Error(FSComp.SR.chkNoWriteToLimitedSpan(vref.DisplayName), m))
+ errorR(RichError(FSComp.SR.chkNoWriteToLimitedSpan(richTextOfValName g vref.Deref), m))
NoLimit
| TOp.AnonRecdGet _, _, [arg1]
@@ -1669,7 +1670,7 @@ and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr =
let isLhsLimited = not (HasLimitFlag LimitFlags.ByRefOfStackReferringSpanLike limit1)
let isRhsLimited = HasLimitFlag LimitFlags.StackReferringSpanLike limit2
if isLhsLimited && isRhsLimited then
- errorR(Error(FSComp.SR.chkNoWriteToLimitedSpan(rf.FieldName), m))
+ errorR(RichError(FSComp.SR.chkNoWriteToLimitedSpan(RichText.mkRecordField rf.FieldName), m))
NoLimit
| TOp.Coerce, [tgtTy;srcTy], [x] ->
@@ -1688,7 +1689,7 @@ and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr =
| TOp.ValFieldGetAddr (rfref, _readonly), tyargs, [] ->
if ctxt.Disallow && cenv.reportErrors && isByrefLikeTy g m (tyOfExpr g expr) then
- errorR(Error(FSComp.SR.chkNoAddressStaticFieldAtThisPoint(rfref.FieldName), m))
+ errorR(RichError(FSComp.SR.chkNoAddressStaticFieldAtThisPoint(RichText.mkRecordField rfref.FieldName), m))
CheckTypeInstNoByrefs cenv env m tyargs
NoLimit
@@ -1697,7 +1698,7 @@ and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr =
| TOp.ValFieldGetAddr (rfref, _readonly), tyargs, [obj] ->
if ctxt.Disallow && cenv.reportErrors && isByrefLikeTy g m (tyOfExpr g expr) then
- errorR(Error(FSComp.SR.chkNoAddressFieldAtThisPoint(rfref.FieldName), m))
+ errorR(RichError(FSComp.SR.chkNoAddressFieldAtThisPoint(RichText.mkRecordField rfref.FieldName), m))
// C# applies a rule where the APIs to struct types can't return the addresses of fields in that struct.
// There seems no particular reason for this given that other protections in the language, though allowing
@@ -1706,7 +1707,7 @@ and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr =
errorR(Error(FSComp.SR.chkStructsMayNotReturnAddressesOfContents(), m))
if ctxt.Disallow && cenv.reportErrors && isByrefLikeTy g m (tyOfExpr g expr) then
- errorR(Error(FSComp.SR.chkNoAddressFieldAtThisPoint(rfref.FieldName), m))
+ errorR(RichError(FSComp.SR.chkNoAddressFieldAtThisPoint(RichText.mkRecordField rfref.FieldName), m))
// This construct is used for &(rx.rfield) and &(rx->rfield). Relax to permit byref types for rx. [See Bug 1263].
CheckTypeInstNoByrefs cenv env m tyargs
@@ -1725,7 +1726,7 @@ and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr =
| TOp.UnionCaseFieldGetAddr (uref, _idx, _readonly), tyargs, [obj] ->
if ctxt.Disallow && cenv.reportErrors && isByrefLikeTy g m (tyOfExpr g expr) then
- errorR(Error(FSComp.SR.chkNoAddressFieldAtThisPoint(uref.CaseName), m))
+ errorR(RichError(FSComp.SR.chkNoAddressFieldAtThisPoint(RichText.mkUnionCase uref.CaseName), m))
if ctxt.PermitOnlyReturnable && (match stripDebugPoints obj with Expr.Val (vref, _, _) -> vref.IsMemberThisVal | _ -> false) && isByrefTy g (tyOfExpr g obj) then
errorR(Error(FSComp.SR.chkStructsMayNotReturnAddressesOfContents(), m))
@@ -1757,13 +1758,13 @@ and CheckExprOp cenv env (op, tyargs, args, m) ctxt expr =
| [ I_ldsflda fspec ], [] ->
if ctxt.Disallow && cenv.reportErrors && isByrefLikeTy g m (tyOfExpr g expr) then
- errorR(Error(FSComp.SR.chkNoAddressFieldAtThisPoint(fspec.Name), m))
+ errorR(RichError(FSComp.SR.chkNoAddressFieldAtThisPoint(RichText.mkField fspec.Name), m))
NoLimit
| [ I_ldflda fspec ], [obj] ->
if ctxt.Disallow && cenv.reportErrors && isByrefLikeTy g m (tyOfExpr g expr) then
- errorR(Error(FSComp.SR.chkNoAddressFieldAtThisPoint(fspec.Name), m))
+ errorR(RichError(FSComp.SR.chkNoAddressFieldAtThisPoint(RichText.mkField fspec.Name), m))
// Recursively check in same ctxt, e.g. if at PermitOnlyReturnable the obj arg must also be returnable
CheckExpr cenv env obj ctxt
@@ -1845,12 +1846,12 @@ and CheckLambdas isTop (memberVal: Val option) cenv env inlined valReprInfo alwa
if arg.IsCompilerGenerated then
errorR(Error(FSComp.SR.chkErrorUseOfByref(), arg.Range))
else
- errorR(Error(FSComp.SR.chkInvalidFunctionParameterType(arg.DisplayName, NicePrint.minimalStringOfType cenv.denv arg.Type), arg.Range))
+ errorR(RichError(FSComp.SR.chkInvalidFunctionParameterType(RichText.mkParameter arg.DisplayName, NicePrint.minimalRichTextOfType cenv.denv arg.Type), arg.Range))
)
// Check return type
CheckTypeAux permitByRefType cenv env mOrig bodyTy (fun () ->
- errorR(Error(FSComp.SR.chkInvalidFunctionReturnType(NicePrint.minimalStringOfType cenv.denv bodyTy), mOrig))
+ errorR(RichError(FSComp.SR.chkInvalidFunctionReturnType(NicePrint.minimalRichTextOfType cenv.denv bodyTy), mOrig))
)
for arg in syntacticArgs do
@@ -2053,7 +2054,7 @@ and CheckAttribs cenv env (attribs: Attribs) =
if cenv.reportErrors then
for tcref, _, m in duplicates do
- errorR(Error(FSComp.SR.chkAttrHasAllowMultiFalse(tcref.DisplayName), m))
+ errorR(RichError(FSComp.SR.chkAttrHasAllowMultiFalse(richTextOfEntityRef tcref), m))
attribs |> List.iter (CheckAttrib cenv env)
@@ -2103,7 +2104,7 @@ and CheckInlineValueIsSufficientlyAccessible cenv env (v: Val) bindRhs =
else
true))
if escapes bindRhs then
- errorR(Error(FSComp.SR.optValueMarkedInlineButIncomplete(v.DisplayName), v.Range))
+ errorR(RichError(FSComp.SR.optValueMarkedInlineButIncomplete(richTextOfValName cenv.g v), v.Range))
and CheckBinding cenv env alwaysCheckNoReraise ctxt (TBind(v, bindRhs, _) as bind) : Limit =
let vref = mkLocalValRef v
@@ -2119,14 +2120,14 @@ and CheckBinding cenv env alwaysCheckNoReraise ctxt (TBind(v, bindRhs, _) as bin
let hasFreeTypars = doesActivePatternHaveFreeTypars g vref
if apinfo.ActiveTags.Length > 1 && hasFreeTypars then
- errorR(Error(FSComp.SR.activePatternChoiceHasFreeTypars(v.LogicalName), v.Range))
+ errorR(RichError(FSComp.SR.activePatternChoiceHasFreeTypars(RichText.mkActivePatternCase v.LogicalName), v.Range))
| _ -> ()
match cenv.potentialUnboundUsesOfVals.TryFind v.Stamp with
| None -> ()
| Some m ->
let nm = v.DisplayName
- errorR(Error(FSComp.SR.chkMemberUsedInInvalidWay(nm, nm, stringOfRange m), v.Range))
+ errorR(RichError(FSComp.SR.chkMemberUsedInInvalidWay(RichText.mkMember nm, RichText.mkMember nm, RichText.mkText (stringOfRange m)), v.Range))
v.Type |> CheckTypePermitAllByrefs cenv env v.Range
v.Attribs |> CheckAttribs cenv env
@@ -2135,7 +2136,7 @@ and CheckBinding cenv env alwaysCheckNoReraise ctxt (TBind(v, bindRhs, _) as bin
// Check accessibility
if (v.IsMemberOrModuleBinding || v.IsMember) && not v.IsIncrClassGeneratedMember then
let access = AdjustAccess (IsHiddenVal env.sigToImplRemapInfo v) (fun () -> v.DeclaringEntity.CompilationPath) v.Accessibility
- CheckTypeForAccess cenv env (fun () -> NicePrint.stringOfQualifiedValOrMember cenv.denv cenv.infoReader vref) access v.Range v.Type
+ CheckTypeForAccess cenv env (fun () -> NicePrint.richTextOfQualifiedValOrMember cenv.denv cenv.infoReader vref) access v.Range v.Type
CheckInlineValueIsSufficientlyAccessible cenv env v bindRhs
@@ -2362,7 +2363,7 @@ let CheckRecdField isUnion cenv env (tycon: Tycon) (rfield: RecdField) =
IsHiddenTyconRepr env.sigToImplRemapInfo tycon ||
(not isUnion && IsHiddenRecdField env.sigToImplRemapInfo (tcref.MakeNestedRecdFieldRef rfield))
let access = AdjustAccess isHidden (fun () -> tycon.CompilationPath) rfield.Accessibility
- CheckTypeForAccess cenv env (fun () -> rfield.LogicalName) access m fieldTy
+ CheckTypeForAccess cenv env (fun () -> RichText.mkRecordField rfield.LogicalName) access m fieldTy
if isByrefLikeTyconRef g m tcref then
// Permit Span fields in IsByRefLike types
@@ -2392,7 +2393,7 @@ let CheckEntityDefn cenv env (tycon: Entity) =
CheckAttribs cenv env tycon.Attribs
match tycon.TypeAbbrev with
- | Some abbrev -> WarnOnWrongTypeForAccess cenv env (fun () -> tycon.CompiledName) tycon.Accessibility tycon.Range abbrev
+ | Some abbrev -> WarnOnWrongTypeForAccess cenv env (fun () -> richTextOfEntityName tycon tycon.CompiledName) tycon.Accessibility tycon.Range abbrev
| _ -> ()
if cenv.reportErrors then
@@ -2461,14 +2462,14 @@ let CheckEntityDefn cenv env (tycon: Entity) =
if others |> List.exists (checkForDup EraseAll) then
if others |> List.exists (checkForDup EraseNone) then
- errorR(Error(FSComp.SR.chkDuplicateMethod(nm, NicePrint.minimalStringOfType cenv.denv ty), m))
+ errorR(RichError(FSComp.SR.chkDuplicateMethod(RichText.mkMethod nm, NicePrint.minimalRichTextOfType cenv.denv ty), m))
else
- errorR(Error(FSComp.SR.chkDuplicateMethodWithSuffix(nm, NicePrint.minimalStringOfType cenv.denv ty), m))
+ errorR(RichError(FSComp.SR.chkDuplicateMethodWithSuffix(RichText.mkMethod nm, NicePrint.minimalRichTextOfType cenv.denv ty), m))
let numCurriedArgSets = minfo.NumArgs.Length
if numCurriedArgSets > 1 && others |> List.exists (fun minfo2 -> not (IsAbstractDefaultPair2 minfo minfo2)) then
- errorR(Error(FSComp.SR.chkDuplicateMethodCurried(nm, NicePrint.minimalStringOfType cenv.denv ty), m))
+ errorR(RichError(FSComp.SR.chkDuplicateMethodCurried(RichText.mkMethod nm, NicePrint.minimalRichTextOfType cenv.denv ty), m))
if numCurriedArgSets > 1 &&
(minfo.GetParamDatas(cenv.amap, m, minfo.FormalMethodInst)
@@ -2488,14 +2489,14 @@ let CheckEntityDefn cenv env (tycon: Entity) =
let errorIfNotStringTy m ty callerInfo =
if not (typeEquiv g g.string_ty ty) then
- errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo |> string, "string", NicePrint.minimalStringOfType cenv.denv ty), m))
+ errorR(RichError(FSComp.SR.tcCallerInfoWrongType(RichText.mkText (callerInfo |> string), RichText.mkText "string", NicePrint.minimalRichTextOfType cenv.denv ty), m))
let errorIfNotOptional tyToCompare desiredTyName m ty callerInfo =
match tryDestOptionalTy g ty with
| ValueSome t when typeEquiv g tyToCompare t -> ()
- | ValueSome innerTy -> errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo |> string, desiredTyName, NicePrint.minimalStringOfType cenv.denv innerTy), m))
- | ValueNone -> errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo |> string, desiredTyName, NicePrint.minimalStringOfType cenv.denv ty), m))
+ | ValueSome innerTy -> errorR(RichError(FSComp.SR.tcCallerInfoWrongType(RichText.mkText (callerInfo |> string), RichText.mkText desiredTyName, NicePrint.minimalRichTextOfType cenv.denv innerTy), m))
+ | ValueNone -> errorR(RichError(FSComp.SR.tcCallerInfoWrongType(RichText.mkText (callerInfo |> string), RichText.mkText desiredTyName, NicePrint.minimalRichTextOfType cenv.denv ty), m))
minfo.GetParamDatas(cenv.amap, m, minfo.FormalMethodInst)
|> List.iterSquared (fun (ParamData(_, isInArg, _, optArgInfo, callerInfo, nameOpt, _, ty)) ->
@@ -2508,10 +2509,10 @@ let CheckEntityDefn cenv env (tycon: Entity) =
match (optArgInfo, callerInfo) with
| _, NoCallerInfo -> ()
- | NotOptional, _ -> errorR(Error(FSComp.SR.tcCallerInfoNotOptional(callerInfo |> string), m))
+ | NotOptional, _ -> errorR(RichError(FSComp.SR.tcCallerInfoNotOptional(RichText.mkText (callerInfo |> string)), m))
| CallerSide _, CallerLineNumber ->
if not (typeEquiv g g.int32_ty ty) then
- errorR(Error(FSComp.SR.tcCallerInfoWrongType(callerInfo |> string, "int", NicePrint.minimalStringOfType cenv.denv ty), m))
+ errorR(RichError(FSComp.SR.tcCallerInfoWrongType(RichText.mkText (callerInfo |> string), RichText.mkText "int", NicePrint.minimalRichTextOfType cenv.denv ty), m))
| CalleeSide, CallerLineNumber -> errorIfNotOptional g.int32_ty "int" m ty callerInfo
| CallerSide _, (CallerFilePath | CallerMemberName) -> errorIfNotStringTy m ty callerInfo
| CalleeSide, (CallerFilePath | CallerMemberName) -> errorIfNotOptional g.string_ty "string" m ty callerInfo
@@ -2525,12 +2526,12 @@ let CheckEntityDefn cenv env (tycon: Entity) =
| Some vref -> vref.DefinitionRange
if hashOfImmediateMeths.ContainsKey nm then
- errorR(Error(FSComp.SR.chkPropertySameNameMethod(nm, NicePrint.minimalStringOfType cenv.denv ty), m))
+ errorR(RichError(FSComp.SR.chkPropertySameNameMethod(RichText.mkProperty nm, NicePrint.minimalRichTextOfType cenv.denv ty), m))
let others = getHash hashOfImmediateProps nm
if pinfo.HasGetter && pinfo.HasSetter && pinfo.GetterMethod.IsVirtual <> pinfo.SetterMethod.IsVirtual then
- errorR(Error(FSComp.SR.chkGetterSetterDoNotMatchAbstract(nm, NicePrint.minimalStringOfType cenv.denv ty), m))
+ errorR(RichError(FSComp.SR.chkGetterSetterDoNotMatchAbstract(RichText.mkProperty nm, NicePrint.minimalRichTextOfType cenv.denv ty), m))
let checkForDup erasureFlag pinfo2 =
// abstract/default pairs of duplicate properties are OK
@@ -2542,9 +2543,9 @@ let CheckEntityDefn cenv env (tycon: Entity) =
if others |> List.exists (checkForDup EraseAll) then
if others |> List.exists (checkForDup EraseNone) then
- errorR(Error(FSComp.SR.chkDuplicateProperty(nm, NicePrint.minimalStringOfType cenv.denv ty), m))
+ errorR(RichError(FSComp.SR.chkDuplicateProperty(RichText.mkProperty nm, NicePrint.minimalRichTextOfType cenv.denv ty), m))
else
- errorR(Error(FSComp.SR.chkDuplicatePropertyWithSuffix(nm, NicePrint.minimalStringOfType cenv.denv ty), m))
+ errorR(RichError(FSComp.SR.chkDuplicatePropertyWithSuffix(RichText.mkProperty nm, NicePrint.minimalRichTextOfType cenv.denv ty), m))
// Check to see if one is an indexer and one is not
if ( (pinfo.HasGetter &&
@@ -2556,7 +2557,7 @@ let CheckEntityDefn cenv env (tycon: Entity) =
(let nargs = pinfo.GetParamTypes(cenv.amap, m).Length
others |> List.exists (fun pinfo2 -> isNil(pinfo2.GetParamTypes(cenv.amap, m)) <> (nargs = 0)))) then
- errorR(Error(FSComp.SR.chkPropertySameNameIndexer(nm, NicePrint.minimalStringOfType cenv.denv ty), m))
+ errorR(RichError(FSComp.SR.chkPropertySameNameIndexer(RichText.mkProperty nm, NicePrint.minimalRichTextOfType cenv.denv ty), m))
// Check to see if the signatures of the both getter and the setter imply the same property type
@@ -2565,9 +2566,9 @@ let CheckEntityDefn cenv env (tycon: Entity) =
let ty2 = pinfo.DropGetter().GetPropertyType(cenv.amap, m)
if not (typeEquivAux EraseNone cenv.amap.g ty1 ty2) then
if g.langVersion.SupportsFeature(LanguageFeature.WarningIndexedPropertiesGetSetSameType) && pinfo.IsIndexer then
- warning(Error(FSComp.SR.chkIndexedGetterAndSetterHaveSamePropertyType(pinfo.PropertyName, NicePrint.minimalStringOfType cenv.denv ty1, NicePrint.minimalStringOfType cenv.denv ty2), m))
+ warning(RichError(FSComp.SR.chkIndexedGetterAndSetterHaveSamePropertyType(RichText.mkProperty pinfo.PropertyName, NicePrint.minimalRichTextOfType cenv.denv ty1, NicePrint.minimalRichTextOfType cenv.denv ty2), m))
if not pinfo.IsIndexer then
- errorR(Error(FSComp.SR.chkGetterAndSetterHaveSamePropertyType(pinfo.PropertyName, NicePrint.minimalStringOfType cenv.denv ty1, NicePrint.minimalStringOfType cenv.denv ty2), m))
+ errorR(RichError(FSComp.SR.chkGetterAndSetterHaveSamePropertyType(RichText.mkProperty pinfo.PropertyName, NicePrint.minimalRichTextOfType cenv.denv ty1, NicePrint.minimalRichTextOfType cenv.denv ty2), m))
hashOfImmediateProps[nm] <- pinfo :: others
@@ -2586,11 +2587,11 @@ let CheckEntityDefn cenv env (tycon: Entity) =
match parentMethsOfSameName |> List.tryFind (checkForDup EraseAll) with
| None -> ()
| Some minfo ->
- let mtext = NicePrint.stringOfMethInfo cenv.infoReader m cenv.denv minfo
+ let mtext = NicePrint.richTextOfMethInfo cenv.infoReader m cenv.denv minfo
if parentMethsOfSameName |> List.exists (checkForDup EraseNone) then
- warning(Error(FSComp.SR.tcNewMemberHidesAbstractMember mtext, m))
+ warning(RichError(FSComp.SR.tcNewMemberHidesAbstractMember mtext, m))
else
- warning(Error(FSComp.SR.tcNewMemberHidesAbstractMemberWithSuffix mtext, m))
+ warning(RichError(FSComp.SR.tcNewMemberHidesAbstractMemberWithSuffix mtext, m))
if minfo.IsDispatchSlot then
@@ -2601,9 +2602,9 @@ let CheckEntityDefn cenv env (tycon: Entity) =
if parentMethsOfSameName |> List.exists (checkForDup EraseAll) then
if parentMethsOfSameName |> List.exists (checkForDup EraseNone) then
- errorR(Error(FSComp.SR.chkDuplicateMethodInheritedType nm, m))
+ errorR(RichError(FSComp.SR.chkDuplicateMethodInheritedType (RichText.mkMethod nm), m))
else
- errorR(Error(FSComp.SR.chkDuplicateMethodInheritedTypeWithSuffix nm, m))
+ errorR(RichError(FSComp.SR.chkDuplicateMethodInheritedTypeWithSuffix (RichText.mkMethod nm), m))
// Must use name-based matching (not type-identity) because user code can define
@@ -2642,7 +2643,7 @@ let CheckEntityDefn cenv env (tycon: Entity) =
// Access checks
let access = AdjustAccess (IsHiddenTycon env.sigToImplRemapInfo tycon) (fun () -> tycon.CompilationPath) tycon.Accessibility
- let visitType ty = CheckTypeForAccess cenv env (fun () -> tycon.DisplayNameWithStaticParametersAndUnderscoreTypars) access tycon.Range ty
+ let visitType ty = CheckTypeForAccess cenv env (fun () -> richTextOfEntityName tycon tycon.DisplayNameWithStaticParametersAndUnderscoreTypars) access tycon.Range ty
abstractSlotValsOfTycons [tycon] |> List.iter (typeOfVal >> visitType)
@@ -2761,7 +2762,7 @@ let CheckForDuplicateExtensionMemberNames (cenv: cenv) (vals: Val seq) =
// Found extensions for types with same LogicalName but different fully qualified names
// Report error on the second (and subsequent) extensions
for v in members |> List.skip 1 do
- errorR(Error(FSComp.SR.tcDuplicateExtensionMemberNames(logicalName), v.Range))
+ errorR(RichError(FSComp.SR.tcDuplicateExtensionMemberNames(RichText.mkMember logicalName), v.Range))
let rec CheckDefnsInModule cenv env mdefs =
for mdef in mdefs do
diff --git a/src/Compiler/Checking/QuotationTranslator.fs b/src/Compiler/Checking/QuotationTranslator.fs
index 82a1fe07145..89c301954b6 100644
--- a/src/Compiler/Checking/QuotationTranslator.fs
+++ b/src/Compiler/Checking/QuotationTranslator.fs
@@ -302,7 +302,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : Exp
let ty = tyOfExpr g expr
match (freeInExpr CollectTyparsAndLocalsNoCaching x0).FreeLocals |> Seq.tryPick (fun v -> if env.vs.ContainsVal v then Some v else None) with
- | Some v -> errorR(Error(FSComp.SR.crefBoundVarUsedInSplice(v.DisplayName), v.Range))
+ | Some v -> errorR(RichError(FSComp.SR.crefBoundVarUsedInSplice(richTextOfValName cenv.g v), v.Range))
| None -> ()
cenv.exprSplices.Add((x0, m))
diff --git a/src/Compiler/Checking/SignatureConformance.fs b/src/Compiler/Checking/SignatureConformance.fs
index 293a8d8e781..4e4e979bccb 100644
--- a/src/Compiler/Checking/SignatureConformance.fs
+++ b/src/Compiler/Checking/SignatureConformance.fs
@@ -28,15 +28,15 @@ open FSharp.Compiler.TypeProviders
type TypeMismatchSource = NullnessOnlyMismatch | RegularMismatch
-exception RequiredButNotSpecified of DisplayEnv * ModuleOrNamespaceRef * string * (StringBuilder -> unit) * range
+exception RequiredButNotSpecified of DisplayEnv * ModuleOrNamespaceRef * string * (RichTextBuilder -> unit) * range
-exception ValueNotContained of kind:TypeMismatchSource * DisplayEnv * InfoReader * ModuleOrNamespaceRef * Val * Val * (string * string * string -> string)
+exception ValueNotContained of kind:TypeMismatchSource * DisplayEnv * InfoReader * ModuleOrNamespaceRef * Val * Val * (RichText * RichText * RichText -> RichText)
-exception UnionCaseNotContained of DisplayEnv * InfoReader * Tycon * UnionCase * UnionCase * (string * string -> string)
+exception UnionCaseNotContained of DisplayEnv * InfoReader * Tycon * UnionCase * UnionCase * (RichText * RichText -> RichText)
-exception FSharpExceptionNotContained of DisplayEnv * InfoReader * Tycon * Tycon * (string * string -> string)
+exception FSharpExceptionNotContained of DisplayEnv * InfoReader * Tycon * Tycon * (RichText * RichText -> RichText)
-exception FieldNotContained of kind:TypeMismatchSource * DisplayEnv * InfoReader * Tycon * Tycon * RecdField * RecdField * (string * string -> string)
+exception FieldNotContained of kind:TypeMismatchSource * DisplayEnv * InfoReader * Tycon * Tycon * RecdField * RecdField * (RichText * RichText -> RichText)
exception InterfaceNotRevealed of DisplayEnv * TType * range
@@ -130,7 +130,7 @@ module private AttributeConformance =
for flag in policy do
if flag |> Flags.intersects missing then
let m = rangeOfMissing classify implAttribs flag fallback
- emit(Error (FSComp.SR.implAttributeMissingFromSignature(displayName flag, displayNameOf impl), m))
+ emit(RichError (FSComp.SR.implAttributeMissingFromSignature(RichText.mkClass (displayName flag), RichText.mkText (displayNameOf impl)), m))
let private emitter (g: TcGlobals) : exn -> unit =
if g.langVersion.SupportsFeature LanguageFeature.ErrorOnMissingSignatureAttribute then
@@ -235,7 +235,7 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
if existsSimilarAttrib then
let (Attrib(implTcref, _, _, _, _, _, implRange)) = implAttrib
- warning(Error(FSComp.SR.tcAttribArgsDiffer(implTcref.DisplayName), implRange))
+ warning(RichError(FSComp.SR.tcAttribArgsDiffer(richTextOfEntityRef implTcref), implRange))
check keptImplAttribsRev remainingImplAttribs sigAttribs
else
check (implAttrib :: keptImplAttribsRev) remainingImplAttribs sigAttribs
@@ -284,7 +284,7 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
| TyparConstraint.DefaultsTo(_, _acty, _) -> true
| _ ->
if not (List.exists (typarConstraintsAEquiv g aenv implTyparCx) sigTypar.Constraints)
- then (errorR(Error(FSComp.SR.typrelSigImplNotCompatibleConstraintsDiffer(sigTypar.Name, LayoutRender.showL(NicePrint.layoutTyparConstraint denv (implTypar, implTyparCx))), m)); false)
+ then (errorR(RichError(FSComp.SR.typrelSigImplNotCompatibleConstraintsDiffer(RichText.mkTypeParameter sigTypar.Name, LayoutRender.toRichText (NicePrint.layoutTyparConstraint denv (implTypar, implTyparCx))), m)); false)
else true) &&
// Check the constraints in the signature are present in the implementation
@@ -297,13 +297,15 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
| TyparConstraint.SupportsEquality _ -> true
| _ ->
if not (List.exists (fun implTyparCx -> typarConstraintsAEquiv g aenv implTyparCx sigTyparCx) implTypar.Constraints) then
- (errorR(Error(FSComp.SR.typrelSigImplNotCompatibleConstraintsDifferRemove(sigTypar.Name, LayoutRender.showL(NicePrint.layoutTyparConstraint denv (sigTypar, sigTyparCx))), m)); false)
+ (errorR(RichError(FSComp.SR.typrelSigImplNotCompatibleConstraintsDifferRemove(RichText.mkTypeParameter sigTypar.Name, LayoutRender.toRichText (NicePrint.layoutTyparConstraint denv (sigTypar, sigTyparCx))), m)); false)
else
true) &&
(not checkingSig || checkAttribs aenv implTypar.Attribs sigTypar.Attribs implTypar.SetAttribs))
and checkTypeDef (aenv: TypeEquivEnv) (infoReader: InfoReader) (implTycon: Tycon) (sigTycon: Tycon) =
let m = implTycon.Range
+ let kindText = RichText.mkText (implTycon.TypeOrMeasureKind.ToString())
+ let implTyconName = richTextOfEntity implTycon
implTycon.SetOtherXmlDoc(sigTycon.XmlDoc)
@@ -314,12 +316,12 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
checkEnforcedEntityAttribs implTycon sigTycon m
if implTycon.LogicalName <> sigTycon.LogicalName then
- errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleNamesDiffer(implTycon.TypeOrMeasureKind.ToString(), sigTycon.LogicalName, implTycon.LogicalName), m))
+ errorR (RichError (FSComp.SR.DefinitionsInSigAndImplNotCompatibleNamesDiffer(kindText, richTextOfEntityName sigTycon sigTycon.LogicalName, richTextOfEntityName implTycon implTycon.LogicalName), m))
false
else
if implTycon.CompiledName <> sigTycon.CompiledName then
- errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleNamesDiffer(implTycon.TypeOrMeasureKind.ToString(), sigTycon.CompiledName, implTycon.CompiledName), m))
+ errorR (RichError (FSComp.SR.DefinitionsInSigAndImplNotCompatibleNamesDiffer(kindText, richTextOfEntityName sigTycon sigTycon.CompiledName, richTextOfEntityName implTycon implTycon.CompiledName), m))
false
else
@@ -329,10 +331,10 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
let sigTypars = sigTycon.Typars
if implTypars.Length <> sigTypars.Length then
- errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleParameterCountsDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m))
+ errorR (RichError(FSComp.SR.DefinitionsInSigAndImplNotCompatibleParameterCountsDiffer(kindText, implTyconName), m))
false
elif isLessAccessible implTycon.Accessibility sigTycon.Accessibility then
- errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleAccessibilityDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m))
+ errorR(RichError(FSComp.SR.DefinitionsInSigAndImplNotCompatibleAccessibilityDiffer(kindText, implTyconName), m))
false
else
let aenv = aenv.BindEquivTypars implTypars sigTypars
@@ -351,8 +353,8 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
let unimplIntfTys = ListSet.subtract (fun sigIntfTy implIntfTy -> typeAEquiv g aenv implIntfTy sigIntfTy) sigIntfTys implIntfTys
(unimplIntfTys
|> List.forall (fun ity ->
- let errorMessage = FSComp.SR.DefinitionsInSigAndImplNotCompatibleMissingInterface(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, NicePrint.minimalStringOfType denv ity)
- errorR (Error(errorMessage, m)); false)) &&
+ let errorMessage = FSComp.SR.DefinitionsInSigAndImplNotCompatibleMissingInterface(kindText, implTyconName, NicePrint.minimalRichTextOfType denv ity)
+ errorR (RichError(errorMessage, m)); false)) &&
let implUserIntfTys = flatten implUserIntfTys
@@ -363,43 +365,43 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
let aNull = IsUnionTypeWithNullAsTrueValue g implTycon
let fNull = IsUnionTypeWithNullAsTrueValue g sigTycon
if aNull && not fNull then
- errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationSaysNull(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m))
+ errorR(RichError(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationSaysNull(kindText, implTyconName), m))
false
elif fNull && not aNull then
- errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureSaysNull(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m))
+ errorR(RichError(FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureSaysNull(kindText, implTyconName), m))
false
else
let aNull2 = TypeNullIsExtraValue g m (generalizedTyconRef g (mkLocalTyconRef implTycon))
let fNull2 = TypeNullIsExtraValue g m (generalizedTyconRef g (mkLocalTyconRef implTycon)) // TODO: should be sigTycon, raises extra errors
if aNull2 && not fNull2 then
- errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationSaysNull2(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m))
+ errorR(RichError(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationSaysNull2(kindText, implTyconName), m))
false
elif fNull2 && not aNull2 then
- errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureSaysNull2(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m))
+ errorR(RichError(FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureSaysNull2(kindText, implTyconName), m))
false
else
let aSealed = isSealedTy g (generalizedTyconRef g (mkLocalTyconRef implTycon))
let fSealed = isSealedTy g (generalizedTyconRef g (mkLocalTyconRef sigTycon))
if aSealed && not fSealed then
- errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationSealed(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m))
+ errorR(RichError(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationSealed(kindText, implTyconName), m))
false
elif not aSealed && fSealed then
- errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationIsNotSealed(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m))
+ errorR(RichError(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationIsNotSealed(kindText, implTyconName), m))
false
else
let aPartial = isAbstractTycon implTycon
let fPartial = isAbstractTycon sigTycon
if aPartial && not fPartial then
- errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationIsAbstract(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m))
+ errorR(RichError(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplementationIsAbstract(kindText, implTyconName), m))
false
elif not aPartial && fPartial then
- errorR(Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureIsAbstract(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m))
+ errorR(RichError(FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureIsAbstract(kindText, implTyconName), m))
false
elif not (typeAEquiv g aenv (superOfTycon g implTycon) (superOfTycon g sigTycon)) then
- errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleTypesHaveDifferentBaseTypes(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m))
+ errorR (RichError(FSComp.SR.DefinitionsInSigAndImplNotCompatibleTypesHaveDifferentBaseTypes(kindText, implTyconName), m))
false
else
@@ -409,7 +411,7 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
checkAttribs aenv implTycon.Attribs sigTycon.Attribs (fun attribs -> implTycon.entity_attribs <- WellKnownEntityAttribs.Create(attribs)) &&
checkModuleOrNamespaceContents implTycon.Range aenv infoReader (mkLocalEntityRef implTycon) sigTycon.ModuleOrNamespaceType
- and checkValInfo aenv err (implVal : Val) (sigVal : Val) =
+ and checkValInfo aenv (err: (RichText * RichText * RichText -> RichText) -> bool) (implVal : Val) (sigVal : Val) =
let id = implVal.Id
match implVal.ValReprInfo, sigVal.ValReprInfo with
| _, None -> true
@@ -419,7 +421,7 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
let mtps = sigTyparNames.Length
let nSigArgInfos = sigArgInfos.Length
if ntps <> mtps then
- err(fun(x, y, z) -> FSComp.SR.ValueNotContainedMutabilityGenericParametersDiffer(x, y, z, string mtps, string ntps))
+ err(fun(x, y, z) -> FSComp.SR.ValueNotContainedMutabilityGenericParametersDiffer(x, y, z, RichText.mkText (string mtps), RichText.mkText (string ntps)))
elif implValInfo.KindsOfTypars <> sigValInfo.KindsOfTypars then
err(FSComp.SR.ValueNotContainedMutabilityGenericParametersAreDifferentKinds)
else
@@ -435,7 +437,9 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
(fst (List.splitAt nSigArgInfos implArgInfos))
if not argGroupsCompatible then
- err(fun(x, y, z) -> FSComp.SR.ValueNotContainedMutabilityAritiesDiffer(x, y, z, id.idText, string nSigArgInfos, id.idText, id.idText))
+ err(fun(x, y, z) ->
+ let name = RichText.mkLocal id.idText
+ FSComp.SR.ValueNotContainedMutabilityAritiesDiffer(x, y, z, name, RichText.mkText (string nSigArgInfos), name, name))
else
let implArgInfos = implArgInfos |> List.truncate nSigArgInfos
// When impl has empty group [] (unit param like member M(())), synthesize
@@ -621,30 +625,32 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
| _ -> false
and checkRecordFields m aenv infoReader (implTycon: Tycon) (sigTycon: Tycon) (implFields: TyconRecdFields) (sigFields: TyconRecdFields) =
+ let kindText = RichText.mkText (implTycon.TypeOrMeasureKind.ToString())
+ let implTyconName = richTextOfEntity implTycon
let implFields = implFields.TrueFieldsAsList
let sigFields = sigFields.TrueFieldsAsList
let m1 = implFields |> NameMap.ofKeyedList (fun rfld -> rfld.LogicalName)
let m2 = sigFields |> NameMap.ofKeyedList (fun rfld -> rfld.LogicalName)
NameMap.suball2
- (fun fieldName _ -> errorR(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldRequiredButNotSpecified(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, fieldName), m)); false)
+ (fun fieldName _ -> errorR(RichError (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldRequiredButNotSpecified(kindText, implTyconName, RichText.mkRecordField fieldName), m)); false)
(checkField aenv infoReader implTycon sigTycon) m1 m2 &&
NameMap.suball2
- (fun fieldName _ -> errorR(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldWasPresent(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, fieldName), m)); false)
+ (fun fieldName _ -> errorR(RichError (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldWasPresent(kindText, implTyconName, RichText.mkRecordField fieldName), m)); false)
(fun x y -> checkField aenv infoReader implTycon sigTycon y x) m2 m1 &&
// This check is required because constructors etc. are externally visible
// and thus compiled representations do pick up dependencies on the field order
(if List.forall2 (checkField aenv infoReader implTycon sigTycon) implFields sigFields
then true
- else (errorR(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldOrderDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false))
+ else (errorR(RichError (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldOrderDiffer(kindText, implTyconName), m)); false))
and checkRecordFieldsForExn _g _denv err aenv (infoReader: InfoReader) (enclosingImplTycon: Tycon) (enclosingSigTycon: Tycon) (implFields: TyconRecdFields) (sigFields: TyconRecdFields) =
let implFields = implFields.TrueFieldsAsList
let sigFields = sigFields.TrueFieldsAsList
let m1 = implFields |> NameMap.ofKeyedList (fun rfld -> rfld.LogicalName)
let m2 = sigFields |> NameMap.ofKeyedList (fun rfld -> rfld.LogicalName)
- NameMap.suball2 (fun s _ -> errorR(err (fun (x, y) -> FSComp.SR.ExceptionDefsNotCompatibleFieldInSigButNotImpl(s, x, y))); false) (checkField aenv infoReader enclosingImplTycon enclosingSigTycon) m1 m2 &&
- NameMap.suball2 (fun s _ -> errorR(err (fun (x, y) -> FSComp.SR.ExceptionDefsNotCompatibleFieldInImplButNotSig(s, x, y))); false) (fun x y -> checkField aenv infoReader enclosingImplTycon enclosingSigTycon y x) m2 m1 &&
+ NameMap.suball2 (fun s _ -> errorR(err (fun (x, y) -> FSComp.SR.ExceptionDefsNotCompatibleFieldInSigButNotImpl(RichText.mkField s, x, y))); false) (checkField aenv infoReader enclosingImplTycon enclosingSigTycon) m1 m2 &&
+ NameMap.suball2 (fun s _ -> errorR(err (fun (x, y) -> FSComp.SR.ExceptionDefsNotCompatibleFieldInImplButNotSig(RichText.mkField s, x, y))); false) (fun x y -> checkField aenv infoReader enclosingImplTycon enclosingSigTycon y x) m2 m1 &&
// This check is required because constructors etc. are externally visible
// and thus compiled representations do pick up dependencies on the field order
(if List.forall2 (checkField aenv infoReader enclosingImplTycon enclosingSigTycon) implFields sigFields
@@ -652,44 +658,48 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
else (errorR(err FSComp.SR.ExceptionDefsNotCompatibleFieldOrderDiffers); false))
and checkVirtualSlots denv infoReader m (implTycon: Tycon) implAbstractSlots sigAbstractSlots =
+ let kindText = RichText.mkText (implTycon.TypeOrMeasureKind.ToString())
+ let implTyconName = richTextOfEntity implTycon
let m1 = NameMap.ofKeyedList (fun (v: ValRef) -> v.DisplayName) implAbstractSlots
let m2 = NameMap.ofKeyedList (fun (v: ValRef) -> v.DisplayName) sigAbstractSlots
(m1, m2) ||> NameMap.suball2 (fun _s vref ->
- let kindText = implTycon.TypeOrMeasureKind.ToString()
- let valText = NicePrint.stringValOrMember denv infoReader vref
- errorR(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleAbstractMemberMissingInImpl(kindText, implTycon.DisplayName, valText), m)); false) (fun _x _y -> true) &&
+ let valText = NicePrint.richTextValOrMember denv infoReader vref
+ errorR(RichError (FSComp.SR.DefinitionsInSigAndImplNotCompatibleAbstractMemberMissingInImpl(kindText, implTyconName, valText), m)); false) (fun _x _y -> true) &&
(m2, m1) ||> NameMap.suball2 (fun _s vref ->
- let kindText = implTycon.TypeOrMeasureKind.ToString()
- let valText = NicePrint.stringValOrMember denv infoReader vref
- errorR(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleAbstractMemberMissingInSig(kindText, implTycon.DisplayName, valText), m)); false) (fun _x _y -> true)
+ let valText = NicePrint.richTextValOrMember denv infoReader vref
+ errorR(RichError (FSComp.SR.DefinitionsInSigAndImplNotCompatibleAbstractMemberMissingInSig(kindText, implTyconName, valText), m)); false) (fun _x _y -> true)
and checkClassFields isStruct m aenv infoReader (implTycon: Tycon) (signTycon: Tycon) (implFields: TyconRecdFields) (sigFields: TyconRecdFields) =
+ let kindText = RichText.mkText (implTycon.TypeOrMeasureKind.ToString())
+ let implTyconName = richTextOfEntity implTycon
let implFields = implFields.TrueFieldsAsList
let sigFields = sigFields.TrueFieldsAsList
let m1 = implFields |> NameMap.ofKeyedList (fun rfld -> rfld.LogicalName)
let m2 = sigFields |> NameMap.ofKeyedList (fun rfld -> rfld.LogicalName)
NameMap.suball2
- (fun fieldName _ -> errorR(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldRequiredButNotSpecified(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, fieldName), m)); false)
+ (fun fieldName _ -> errorR(RichError (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldRequiredButNotSpecified(kindText, implTyconName, RichText.mkRecordField fieldName), m)); false)
(checkField aenv infoReader implTycon signTycon) m1 m2 &&
(if isStruct then
NameMap.suball2
- (fun fieldName _ -> warning(Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldIsInImplButNotSig(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, fieldName), m)); true)
+ (fun fieldName _ -> warning(RichError (FSComp.SR.DefinitionsInSigAndImplNotCompatibleFieldIsInImplButNotSig(kindText, implTyconName, RichText.mkRecordField fieldName), m)); true)
(fun x y -> checkField aenv infoReader implTycon signTycon y x) m2 m1
else
true)
and checkTypeRepr m aenv (infoReader: InfoReader) (implTycon: Tycon) (sigTycon: Tycon) =
+ let kindText = RichText.mkText (implTycon.TypeOrMeasureKind.ToString())
+ let implTyconName = richTextOfEntity implTycon
let reportNiceError k s1 s2 =
let aset = NameSet.ofList s1
let fset = NameSet.ofList s2
match Zset.elements (Zset.diff aset fset) with
| [] ->
match Zset.elements (Zset.diff fset aset) with
- | [] -> (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleNumbersDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, k), m)); false)
- | l -> (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureDefinesButImplDoesNot(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, k, String.concat ";" l), m)); false)
- | l -> (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplDefinesButSignatureDoesNot(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, k, String.concat ";" l), m)); false)
+ | [] -> (errorR (RichError (FSComp.SR.DefinitionsInSigAndImplNotCompatibleNumbersDiffer(kindText, implTyconName, RichText.mkText k), m)); false)
+ | l -> (errorR (RichError (FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureDefinesButImplDoesNot(kindText, implTyconName, RichText.mkText k, RichText.mkText (String.concat ";" l)), m)); false)
+ | l -> (errorR (RichError (FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplDefinesButSignatureDoesNot(kindText, implTyconName, RichText.mkText k, RichText.mkText (String.concat ";" l)), m)); false)
match implTycon.TypeReprInfo, sigTycon.TypeReprInfo with
| (TILObjectRepr _
@@ -701,13 +711,13 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
| TFSharpTyconRepr r, TNoRepr ->
match r.fsobjmodel_kind with
| TFSharpStruct | TFSharpEnum ->
- (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplDefinesStruct(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false)
+ (errorR (RichError(FSComp.SR.DefinitionsInSigAndImplNotCompatibleImplDefinesStruct(kindText, implTyconName), m)); false)
| _ ->
true
| TAsmRepr _, TNoRepr ->
- (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleDotNetTypeRepresentationIsHidden(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false)
+ (errorR (RichError(FSComp.SR.DefinitionsInSigAndImplNotCompatibleDotNetTypeRepresentationIsHidden(kindText, implTyconName), m)); false)
| TMeasureableRepr _, TNoRepr ->
- (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleTypeIsHidden(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false)
+ (errorR (RichError(FSComp.SR.DefinitionsInSigAndImplNotCompatibleTypeIsHidden(kindText, implTyconName), m)); false)
// Union types are compatible with union types in signature
| TFSharpTyconRepr { fsobjmodel_kind=TFSharpUnion; fsobjmodel_cases=r1},
@@ -746,16 +756,16 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
(returnTypesAEquiv g aenv rty1 rty2)))
| _ -> false
if not compat then
- errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleTypeIsDifferentKind(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m))
+ errorR (RichError(FSComp.SR.DefinitionsInSigAndImplNotCompatibleTypeIsDifferentKind(kindText, implTyconName), m))
false
else
let isStruct = (match r1.fsobjmodel_kind with TFSharpStruct -> true | _ -> false)
checkClassFields isStruct m aenv infoReader implTycon sigTycon r1.fsobjmodel_rfields r2.fsobjmodel_rfields &&
checkVirtualSlots denv infoReader m implTycon r1.fsobjmodel_vslots r2.fsobjmodel_vslots
| TAsmRepr tcr1, TAsmRepr tcr2 ->
- if tcr1 <> tcr2 then (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleILDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false) else true
+ if tcr1 <> tcr2 then (errorR (RichError(FSComp.SR.DefinitionsInSigAndImplNotCompatibleILDiffer(kindText, implTyconName), m)); false) else true
| TMeasureableRepr ty1, TMeasureableRepr ty2 ->
- if typeAEquiv g aenv ty1 ty2 then true else (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleRepresentationsDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false)
+ if typeAEquiv g aenv ty1 ty2 then true else (errorR (RichError(FSComp.SR.DefinitionsInSigAndImplNotCompatibleRepresentationsDiffer(kindText, implTyconName), m)); false)
| TNoRepr, TNoRepr -> true
#if !NO_TYPEPROVIDERS
| TProvidedTypeRepr info1, TProvidedTypeRepr info2 ->
@@ -764,13 +774,15 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
System.Diagnostics.Debug.Assert(false, "unreachable: TProvidedNamespaceRepr only on namespaces, not types" )
true
#endif
- | TNoRepr, _ -> (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleRepresentationsDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false)
- | _, _ -> (errorR (Error(FSComp.SR.DefinitionsInSigAndImplNotCompatibleRepresentationsDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false)
+ | TNoRepr, _ -> (errorR (RichError(FSComp.SR.DefinitionsInSigAndImplNotCompatibleRepresentationsDiffer(kindText, implTyconName), m)); false)
+ | _, _ -> (errorR (RichError(FSComp.SR.DefinitionsInSigAndImplNotCompatibleRepresentationsDiffer(kindText, implTyconName), m)); false)
and checkTypeAbbrev m aenv (implTycon: Tycon) (sigTycon: Tycon) =
+ let kindText = RichText.mkText (implTycon.TypeOrMeasureKind.ToString())
+ let implTyconName = richTextOfEntity implTycon
let kind1 = implTycon.TypeOrMeasureKind
let kind2 = sigTycon.TypeOrMeasureKind
- if kind1 <> kind2 then (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureDeclaresDiffer(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName, kind2.ToString(), kind1.ToString()), m)); false)
+ if kind1 <> kind2 then (errorR (RichError (FSComp.SR.DefinitionsInSigAndImplNotCompatibleSignatureDeclaresDiffer(kindText, implTyconName, RichText.mkText (kind2.ToString()), RichText.mkText (kind1.ToString())), m)); false)
else
match implTycon.TypeAbbrev, sigTycon.TypeAbbrev with
| Some ty1, Some ty2 ->
@@ -780,8 +792,8 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
else
true
| None, None -> true
- | Some _, None -> (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleAbbreviationHiddenBySig(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false)
- | None, Some _ -> (errorR (Error (FSComp.SR.DefinitionsInSigAndImplNotCompatibleSigHasAbbreviation(implTycon.TypeOrMeasureKind.ToString(), implTycon.DisplayName), m)); false)
+ | Some _, None -> (errorR (RichError (FSComp.SR.DefinitionsInSigAndImplNotCompatibleAbbreviationHiddenBySig(kindText, implTyconName), m)); false)
+ | None, Some _ -> (errorR (RichError (FSComp.SR.DefinitionsInSigAndImplNotCompatibleSigHasAbbreviation(kindText, implTyconName), m)); false)
and checkModuleOrNamespaceContents m aenv (infoReader: InfoReader) (implModRef: ModuleOrNamespaceRef) (signModType: ModuleOrNamespaceType) =
let implModType = implModRef.ModuleOrNamespaceType
@@ -790,22 +802,22 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) =
(implModType.TypesByMangledName, signModType.TypesByMangledName)
||> NameMap.suball2
- (fun s _fx -> errorR(RequiredButNotSpecified(denv, implModRef, "type", (fun os -> Printf.bprintf os "%s" s), m)); false)
+ (fun s fx -> errorR(RequiredButNotSpecified(denv, implModRef, "type", (fun os -> os.Append(tagEntityRefName (mkLocalEntityRef fx) s)), m)); false)
(checkTypeDef aenv infoReader) &&
(implModType.ModulesAndNamespacesByDemangledName, signModType.ModulesAndNamespacesByDemangledName )
||> NameMap.suball2
- (fun s fx -> errorR(RequiredButNotSpecified(denv, implModRef, (if fx.IsModule then "module" else "namespace"), (fun os -> Printf.bprintf os "%s" s), m)); false)
+ (fun s fx -> errorR(RequiredButNotSpecified(denv, implModRef, (if fx.IsModule then "module" else "namespace"), (fun os -> os.Append(tagEntityRefName (mkLocalModuleRef fx) s)), m)); false)
(fun x1 x2 -> checkModuleOrNamespace aenv infoReader (mkLocalModuleRef x1) x2) &&
let sigValHadNoMatchingImplementation (fx: Val) (_closeActualVal: Val option) =
errorR(RequiredButNotSpecified(denv, implModRef, "value", (fun os ->
(* In the case of missing members show the full required enclosing type and signature *)
if fx.IsMember then
- NicePrint.outputQualifiedValOrMember denv infoReader os (mkLocalValRef fx)
+ os.Append(NicePrint.richTextOfQualifiedValOrMember denv infoReader (mkLocalValRef fx))
else
- Printf.bprintf os "%s" fx.DisplayName), m))
+ os.Append(tagValName g fx fx.DisplayName)), m))
let valuesPartiallyMatch (av: Val) (fv: Val) =
let akey = av.GetLinkagePartialKey()
@@ -898,14 +910,14 @@ let rec CheckNamesOfModuleOrNamespaceContents denv infoReader (implModRef: Modul
let m = implModRef.Range
let implModType = implModRef.ModuleOrNamespaceType
NameMap.suball2
- (fun s _fx -> errorR(RequiredButNotSpecified(denv, implModRef, "type", (fun os -> Printf.bprintf os "%s" s), m)); false)
+ (fun s fx -> errorR(RequiredButNotSpecified(denv, implModRef, "type", (fun os -> os.Append(tagEntityRefName (mkLocalEntityRef fx) s)), m)); false)
(fun _ _ -> true)
implModType.TypesByMangledName
signModType.TypesByMangledName &&
(implModType.ModulesAndNamespacesByDemangledName, signModType.ModulesAndNamespacesByDemangledName )
||> NameMap.suball2
- (fun s fx -> errorR(RequiredButNotSpecified(denv, implModRef, (if fx.IsModule then "module" else "namespace"), (fun os -> Printf.bprintf os "%s" s), m)); false)
+ (fun s fx -> errorR(RequiredButNotSpecified(denv, implModRef, (if fx.IsModule then "module" else "namespace"), (fun os -> os.Append(tagEntityRefName (mkLocalModuleRef fx) s)), m)); false)
(fun x1 (x2: ModuleOrNamespace) -> CheckNamesOfModuleOrNamespace denv infoReader (mkLocalModuleRef x1) x2.ModuleOrNamespaceType) &&
(implModType.AllValsAndMembersByLogicalNameUncached, signModType.AllValsAndMembersByLogicalNameUncached)
@@ -915,9 +927,9 @@ let rec CheckNamesOfModuleOrNamespaceContents denv infoReader (implModRef: Modul
errorR(RequiredButNotSpecified(denv, implModRef, "value", (fun os ->
// In the case of missing members show the full required enclosing type and signature
if Option.isSome fx.MemberInfo then
- NicePrint.outputQualifiedValOrMember denv infoReader os (mkLocalValRef fx)
+ os.Append(NicePrint.richTextOfQualifiedValOrMember denv infoReader (mkLocalValRef fx))
else
- Printf.bprintf os "%s" fx.DisplayName), m)); false)
+ os.Append(tagValName denv.g fx fx.DisplayName)), m)); false)
(fun _ _ -> true)
diff --git a/src/Compiler/Checking/SignatureConformance.fsi b/src/Compiler/Checking/SignatureConformance.fsi
index 136cedce94f..5140e980f25 100644
--- a/src/Compiler/Checking/SignatureConformance.fsi
+++ b/src/Compiler/Checking/SignatureConformance.fsi
@@ -17,7 +17,7 @@ type TypeMismatchSource =
| NullnessOnlyMismatch
| RegularMismatch
-exception RequiredButNotSpecified of DisplayEnv * ModuleOrNamespaceRef * string * (StringBuilder -> unit) * range
+exception RequiredButNotSpecified of DisplayEnv * ModuleOrNamespaceRef * string * (RichTextBuilder -> unit) * range
exception ValueNotContained of
kind: TypeMismatchSource *
@@ -26,11 +26,17 @@ exception ValueNotContained of
ModuleOrNamespaceRef *
Val *
Val *
- (string * string * string -> string)
+ (RichText * RichText * RichText -> RichText)
-exception UnionCaseNotContained of DisplayEnv * InfoReader * Tycon * UnionCase * UnionCase * (string * string -> string)
+exception UnionCaseNotContained of
+ DisplayEnv *
+ InfoReader *
+ Tycon *
+ UnionCase *
+ UnionCase *
+ (RichText * RichText -> RichText)
-exception FSharpExceptionNotContained of DisplayEnv * InfoReader * Tycon * Tycon * (string * string -> string)
+exception FSharpExceptionNotContained of DisplayEnv * InfoReader * Tycon * Tycon * (RichText * RichText -> RichText)
exception FieldNotContained of
kind: TypeMismatchSource *
@@ -40,7 +46,7 @@ exception FieldNotContained of
Tycon *
RecdField *
RecdField *
- (string * string -> string)
+ (RichText * RichText -> RichText)
exception InterfaceNotRevealed of DisplayEnv * TType * range
diff --git a/src/Compiler/Checking/TailCallChecks.fs b/src/Compiler/Checking/TailCallChecks.fs
index 87ee24bbdb4..c9f7246eb5d 100644
--- a/src/Compiler/Checking/TailCallChecks.fs
+++ b/src/Compiler/Checking/TailCallChecks.fs
@@ -220,7 +220,7 @@ let CheckForNonTailRecCall (cenv: cenv) expr (tailCall: TailCall) =
// ``Warn successfully in match clause``
// ``Warn for byref parameters``
if not canTailCall then
- warning (Error(FSComp.SR.chkNotTailRecursive vref.DisplayName, m))
+ warning (RichError(FSComp.SR.chkNotTailRecursive (richTextOfValName g vref.Deref), m))
| _ -> ()
| _ -> ()
@@ -780,7 +780,7 @@ let CheckModuleBinding cenv (isRec: bool) (TBind _ as bind) =
match expr with
| Expr.Val(valRef = valRef; range = m) ->
if isRec && insideSubBindingOrTry && cenv.mustTailCall.Contains valRef.Deref then
- warning (Error(FSComp.SR.chkNotTailRecursive valRef.DisplayName, m))
+ warning (RichError(FSComp.SR.chkNotTailRecursive (richTextOfValName cenv.g valRef.Deref), m))
| Expr.App(funcExpr = funcExpr; args = argExprs) ->
checkTailCall insideSubBindingOrTry funcExpr
argExprs |> List.iter (checkTailCall insideSubBindingOrTry)
diff --git a/src/Compiler/Checking/TypeHierarchy.fs b/src/Compiler/Checking/TypeHierarchy.fs
index ec788a3204a..ed75fef8e91 100644
--- a/src/Compiler/Checking/TypeHierarchy.fs
+++ b/src/Compiler/Checking/TypeHierarchy.fs
@@ -3,6 +3,7 @@
module internal FSharp.Compiler.TypeHierarchy
open Internal.Utilities.Library.Extras
+open FSharp.Compiler.Text
open FSharp.Compiler.AbstractIL.IL
open FSharp.Compiler.DiagnosticsLogger
open FSharp.Compiler.Import
@@ -251,7 +252,7 @@ let FoldHierarchyOfTypeAux followInterfaces allowMultiIntfInst skipUnref visitor
| _ ->
state
- if ndeep > 100 then (errorR(Error((FSComp.SR.recursiveClassHierarchy (showType ty)), m)); (visitedTycon, visited, acc)) else
+ if ndeep > 100 then (errorR(RichError((FSComp.SR.recursiveClassHierarchy (RichText.mkText (showType ty))), m)); (visitedTycon, visited, acc)) else
let visitedTycon, visited, acc =
if isInterfaceTy g ty then
List.foldBack
diff --git a/src/Compiler/Checking/TypeRelations.fs b/src/Compiler/Checking/TypeRelations.fs
index 021370f2067..00bb882c544 100644
--- a/src/Compiler/Checking/TypeRelations.fs
+++ b/src/Compiler/Checking/TypeRelations.fs
@@ -4,6 +4,7 @@
/// constraint solving and method overload resolution.
module internal FSharp.Compiler.TypeRelations
+open FSharp.Compiler.Text
open FSharp.Compiler.Features
open Internal.Utilities.Collections
open Internal.Utilities.Library
@@ -193,7 +194,7 @@ let ChooseTyparSolutionAndRange (g: TcGlobals) amap (tp:Typar) =
let join m x =
if TypeFeasiblySubsumesType 0 g amap m x CanCoerce maxTy then maxTy, isRefined
elif TypeFeasiblySubsumesType 0 g amap m maxTy CanCoerce x then x, true
- else errorR(Error(FSComp.SR.typrelCannotResolveImplicitGenericInstantiation((DebugPrint.showType x), (DebugPrint.showType maxTy)), m)); maxTy, isRefined
+ else errorR(RichError(FSComp.SR.typrelCannotResolveImplicitGenericInstantiation(RichText.mkText (DebugPrint.showType x), RichText.mkText (DebugPrint.showType maxTy)), m)); maxTy, isRefined
// Don't continue if an error occurred and we set the value eagerly
if tp.IsSolved then (maxTy, isRefined), m else
match tpc with
diff --git a/src/Compiler/Checking/import.fs b/src/Compiler/Checking/import.fs
index 86538b5c7ab..827c6162eb6 100644
--- a/src/Compiler/Checking/import.fs
+++ b/src/Compiler/Checking/import.fs
@@ -83,6 +83,17 @@ let CanImportILScopeRef (env: ImportMap) m scoref =
| ILScopeRef.Assembly assemblyRef -> isResolved assemblyRef
| ILScopeRef.PrimaryAssembly -> isResolved env.g.ilg.primaryAssemblyRef
+/// A type's qualified name, classifying the enclosing path, the namespace and the name separately. How
+/// the name itself is classified is up to the caller, since the kind of type it is only becomes known
+/// once the type has been dereferenced.
+let private richTextOfQualifiedTypeName (path: string[]) leafOfName typeName =
+ let name = RichText.mkQualifiedName leafOfName typeName
+
+ if Array.isEmpty path then
+ name
+ else
+ RichText.concat [ richTextOfPath (Array.toList path); RichText.mkPunctuation "."; name ]
+
/// Import a reference to a type definition, given the AbstractIL data for the type reference
let ImportTypeRefData (env: ImportMap) m (scoref, path, typeName) =
@@ -106,13 +117,13 @@ let ImportTypeRefData (env: ImportMap) m (scoref, path, typeName) =
match ccu with
| ResolvedCcu ccu->ccu
| UnresolvedCcu ccuName ->
- error (Error(FSComp.SR.impTypeRequiredUnavailable(typeName, ccuName), m))
+ error (RichError(FSComp.SR.impTypeRequiredUnavailable(RichText.mkQualifiedTypeName typeName, RichText.mkText ccuName), m))
let fakeTyconRef = mkNonLocalTyconRef (mkNonLocalEntityRef ccu path) typeName
let tycon =
try
fakeTyconRef.Deref
with _ ->
- error (Error(FSComp.SR.impReferencedTypeCouldNotBeFoundInAssembly(String.concat "." (Array.append path [| typeName |]), ccu.AssemblyName), m))
+ error (RichError(FSComp.SR.impReferencedTypeCouldNotBeFoundInAssembly(richTextOfQualifiedTypeName path RichText.mkUnknownType typeName, RichText.mkText ccu.AssemblyName), m))
#if !NO_TYPEPROVIDERS
// Validate (once because of caching)
match tycon.TypeReprInfo with
@@ -123,7 +134,7 @@ let ImportTypeRefData (env: ImportMap) m (scoref, path, typeName) =
()
#endif
match tryRescopeEntity ccu tycon with
- | ValueNone -> error (Error(FSComp.SR.impImportedAssemblyUsesNotPublicType(String.concat "." (Array.toList path@[typeName])), m))
+ | ValueNone -> error (RichError(FSComp.SR.impImportedAssemblyUsesNotPublicType(richTextOfQualifiedTypeName path (richTextOfEntityName tycon) typeName), m))
| ValueSome tcref -> tcref
@@ -422,7 +433,7 @@ let rec ImportProvidedTypeAsILType (env: ImportMap) (m: range) (st: Tainted genericArgs.Length then
- error(Error(FSComp.SR.impInvalidNumberOfGenericArguments(tcref.CompiledName, tps.Length, genericArgs.Length), m))
+ error(RichError(FSComp.SR.impInvalidNumberOfGenericArguments(richTextOfEntityRefName tcref tcref.CompiledName, tps.Length, genericArgs.Length), m))
// We're converting to an IL type, where generic arguments are erased
let genericArgs = List.zip tps genericArgs |> List.filter (fun (tp, _) -> not tp.IsErased) |> List.map snd
@@ -499,7 +510,7 @@ let rec ImportProvidedType (env: ImportMap) (m: range) (* (tinst: TypeInst) *) (
let tps = tcref.Typars
if tps.Length <> genericArgsLength then
- error(Error(FSComp.SR.impInvalidNumberOfGenericArguments(tcref.CompiledName, tps.Length, genericArgsLength), m))
+ error(RichError(FSComp.SR.impInvalidNumberOfGenericArguments(richTextOfEntityRefName tcref tcref.CompiledName, tps.Length, genericArgsLength), m))
let genericArgs =
(tps, genericArgs) ||> List.map2 (fun tp genericArg ->
@@ -514,10 +525,10 @@ let rec ImportProvidedType (env: ImportMap) (m: range) (* (tinst: TypeInst) *) (
| TType_app (tcref, [], _) when tyconRefEq g tcref g.measureone_tcr -> Measure.One(tcref.Range)
| TType_app (tcref, [], _) when tcref.TypeOrMeasureKind = TyparKind.Measure -> Measure.Const(tcref, tcref.Range)
| TType_app (tcref, _, _) ->
- errorR(Error(FSComp.SR.impInvalidMeasureArgument1(tcref.CompiledName, tp.Name), m))
+ errorR(RichError(FSComp.SR.impInvalidMeasureArgument1(richTextOfEntityRefName tcref tcref.CompiledName, RichText.mkTypeParameter tp.Name), m))
Measure.One tcref.Range
| _ ->
- errorR(Error(FSComp.SR.impInvalidMeasureArgument2(tp.Name), m))
+ errorR(RichError(FSComp.SR.impInvalidMeasureArgument2(RichText.mkTypeParameter tp.Name), m))
Measure.One range0
TType_measure (conv genericArg)
@@ -555,7 +566,7 @@ let ImportProvidedMethodBaseAsILMethodRef (env: ImportMap) (m: range) (mbase: Ta
| None ->
let methodName = minfo.PUntaint((fun minfo -> minfo.Name), m)
let typeName = declaringGenericTypeDefn.PUntaint((fun declaringGenericTypeDefn -> string declaringGenericTypeDefn.FullName), m)
- error(Error(FSComp.SR.etIncorrectProvidedMethod(DisplayNameOfTypeProvider(minfo.TypeProvider, m), methodName, metadataToken, typeName), m))
+ error(RichError(FSComp.SR.etIncorrectProvidedMethod(RichText.mkText (DisplayNameOfTypeProvider(minfo.TypeProvider, m)), RichText.mkMethod methodName, metadataToken, RichText.mkQualifiedTypeName typeName), m))
| _ ->
match mbase.OfType() with
| Some cinfo when cinfo.PUntaint((fun x -> (nonNull x.DeclaringType).IsGenericType), m) ->
@@ -587,7 +598,7 @@ let ImportProvidedMethodBaseAsILMethodRef (env: ImportMap) (m: range) (mbase: Ta
| Some found -> found.Coerce(m)
| None ->
let typeName = declaringGenericTypeDefn.PUntaint((fun x -> string x.FullName), m)
- error(Error(FSComp.SR.etIncorrectProvidedConstructor(DisplayNameOfTypeProvider(cinfo.TypeProvider, m), typeName), m))
+ error(RichError(FSComp.SR.etIncorrectProvidedConstructor(RichText.mkText (DisplayNameOfTypeProvider(cinfo.TypeProvider, m)), RichText.mkQualifiedTypeName typeName), m))
| _ -> mbase
let retTy =
@@ -779,7 +790,7 @@ let ImportILAssemblyExportedType amap m auxModLoader (scoref: ILScopeRef) (expor
with :? KeyNotFoundException -> None)
with
| None ->
- error(Error(FSComp.SR.impReferenceToDllRequiredByAssembly(exportedType.ScopeRef.QualifiedName, scoref.QualifiedName, exportedType.Name), m))
+ error(RichError(FSComp.SR.impReferenceToDllRequiredByAssembly(RichText.mkText exportedType.ScopeRef.QualifiedName, RichText.mkText scoref.QualifiedName, RichText.mkUnknownType exportedType.Name), m))
| Some preTypeDef ->
scoref, preTypeDef
)
diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs
index d4da136b80a..7f39d1bd25a 100644
--- a/src/Compiler/Checking/infos.fs
+++ b/src/Compiler/Checking/infos.fs
@@ -327,7 +327,7 @@ let CrackParamAttribsInfo g (ty: TType, argInfo: ArgReprInfo) =
| false, true, true ->
match attribs with
| ValAttrib g WellKnownValAttributes.CallerMemberNameAttribute (Attrib(_, _, _, _, _, _, callerMemberNameAttributeRange)) ->
- warning(Error(FSComp.SR.CallerMemberNameIsOverridden(argInfo.Name.Value.idText), callerMemberNameAttributeRange))
+ warning(RichError(FSComp.SR.CallerMemberNameIsOverridden(RichText.mkParameter argInfo.Name.Value.idText), callerMemberNameAttributeRange))
CallerFilePath
| _ -> failwith "Impossible"
| _, _, _ ->
@@ -366,7 +366,7 @@ type ILFieldInit with
| :? uint64 as i -> ILFieldInit.UInt64 i
| _ ->
let txt = match v with | null -> "?" | v -> try !!v.ToString() with _ -> "?"
- error(Error(FSComp.SR.infosInvalidProvidedLiteralValue(txt), m))
+ error(RichError(FSComp.SR.infosInvalidProvidedLiteralValue(RichText.mkText txt), m))
/// Compute the OptionalArgInfo for a provided parameter.
@@ -408,7 +408,7 @@ let ArbitraryMethodInfoOfPropertyInfo (pi: Tainted) m =
elif pi.PUntaint((fun pi -> pi.CanWrite), m) then
GetAndSanityCheckProviderMethod m pi (fun pi -> pi.GetSetMethod()) FSComp.SR.etPropertyCanWriteButHasNoSetter
else
- error(Error(FSComp.SR.etPropertyNeedsCanWriteOrCanRead(pi.PUntaint((fun mi -> mi.Name), m), pi.PUntaint((fun mi -> (nonNull mi.DeclaringType).Name), m)), m))
+ error(RichError(FSComp.SR.etPropertyNeedsCanWriteOrCanRead(RichText.mkMember (pi.PUntaint((fun mi -> mi.Name), m)), RichText.mkQualifiedTypeName (pi.PUntaint((fun mi -> (nonNull mi.DeclaringType).Name), m))), m))
#endif
@@ -2274,7 +2274,7 @@ let private tyConformsToIDelegateEvent g ty =
/// Create an error object to raise should an event not have the shape expected by the .NET idiom described further below
let nonStandardEventError nm m =
- Error (FSComp.SR.eventHasNonStandardType(nm, ("add_"+nm), ("remove_"+nm)), m)
+ RichError(FSComp.SR.eventHasNonStandardType(RichText.mkEvent nm, RichText.mkMethod ("add_"+nm), RichText.mkMethod ("remove_"+nm)), m)
/// Find the delegate type that an F# event property implements by looking through the type hierarchy of the type of the property
/// for the first instantiation of IDelegateEvent.
diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs
index c170a757715..c077666dbe8 100644
--- a/src/Compiler/CodeGen/IlxGen.fs
+++ b/src/Compiler/CodeGen/IlxGen.fs
@@ -1397,7 +1397,7 @@ let StorageForVal m v eenv =
eenv.valsInScope[v]
with :? KeyNotFoundException ->
assert false
- errorR (Error(FSComp.SR.ilUndefinedValue (showL (valAtBindL v)), m))
+ errorR (RichError(FSComp.SR.ilUndefinedValue (RichText.mkText (showL (valAtBindL v))), m))
notlazy (Arg 668 (* random value for post-hoc diagnostic analysis on generated tree *) )
v.Force()
@@ -3155,7 +3155,10 @@ and GenExprPreSteps (cenv: cenv) (cgbuf: CodeGenBuffer) eenv expr sequel =
]
|> String.concat ","
- informationalWarning (Error(FSComp.SR.ilxGenUnknownDebugPoint (debugPointName, others), dpExpr.Range))
+ informationalWarning (
+ RichError(FSComp.SR.ilxGenUnknownDebugPoint (RichText.mkText debugPointName, RichText.mkText others), dpExpr.Range)
+ )
+
CG.EmitDebugPoint cgbuf m
| true, dp ->
// printfn $"---- Found debug point {debugPointName} at {m} --> {dp}"
@@ -3207,13 +3210,13 @@ and GenExprPreSteps (cenv: cenv) (cgbuf: CodeGenBuffer) eenv expr sequel =
// is important if the nested state machine generates dynamic code (LoweredStateMachineResult.UseAlternative).
let eenv = RemoveTemplateReplacement eenv
checkLanguageFeatureError cenv.g.langVersion LanguageFeature.ResumableStateMachines expr.Range
- warning (Error(FSComp.SR.reprStateMachineNotCompilable msg, expr.Range))
+ warning (RichError(FSComp.SR.reprStateMachineNotCompilable (RichText.mkText msg), expr.Range))
GenExpr cenv cgbuf eenv altExpr sequel
true
| LoweredStateMachineResult.NoAlternative msg ->
let eenv = RemoveTemplateReplacement eenv
checkLanguageFeatureError cenv.g.langVersion LanguageFeature.ResumableStateMachines expr.Range
- errorR (Error(FSComp.SR.reprStateMachineNotCompilableNoAlternative msg, expr.Range))
+ errorR (RichError(FSComp.SR.reprStateMachineNotCompilableNoAlternative (RichText.mkText msg), expr.Range))
GenDefaultValue cenv cgbuf eenv (tyOfExpr cenv.g expr, expr.Range)
true
| LoweredStateMachineResult.NotAStateMachine ->
@@ -4495,7 +4498,7 @@ and GenApp (cenv: cenv) cgbuf eenv (f, fty, tyargs, curriedArgs, m) sequel =
|| valRefEq g v g.cgh__resumableEntry_vref
|| valRefEq g v g.cgh__stateMachine_vref
->
- errorR (Error(FSComp.SR.ilxgenInvalidConstructInStateMachineDuringCodegen v.DisplayName, m))
+ errorR (RichError(FSComp.SR.ilxgenInvalidConstructInStateMachineDuringCodegen (richTextOfValName g v.Deref), m))
CG.EmitInstr cgbuf (pop 0) (Push [ g.ilg.typ_Object ]) AI_ldnull
GenSequel cenv eenv.cloc cgbuf sequel
@@ -5879,7 +5882,7 @@ and GenGetValAddr cenv cgbuf eenv (v: ValRef, m) sequel =
| Method _
| Env _
| Null ->
- errorR (Error(FSComp.SR.ilAddressOfValueHereIsInvalid v.DisplayName, m))
+ errorR (RichError(FSComp.SR.ilAddressOfValueHereIsInvalid (richTextOfValName cenv.g v.Deref), m))
CG.EmitInstr
cgbuf
@@ -10186,9 +10189,11 @@ and GenSetStorage m cgbuf storage =
CG.EmitInstr cgbuf (pop 1) Push0 (I_call(Normalcall, mkILMethSpecForMethRefInTy (ilSetterMethRef, ilContainerTy, []), None))
- | StaticProperty(ilGetterMethSpec, _) -> error (Error(FSComp.SR.ilStaticMethodIsNotLambda ilGetterMethSpec.Name, m))
+ | StaticProperty(ilGetterMethSpec, _) ->
+ error (RichError(FSComp.SR.ilStaticMethodIsNotLambda (RichText.mkMethod ilGetterMethSpec.Name), m))
- | Method(_, _, mspec, _, m, _, _, _, _, _, _, _) -> error (Error(FSComp.SR.ilStaticMethodIsNotLambda mspec.Name, m))
+ | Method(_, _, mspec, _, m, _, _, _, _, _, _, _) ->
+ error (RichError(FSComp.SR.ilStaticMethodIsNotLambda (RichText.mkMethod mspec.Name), m))
| Null -> CG.EmitInstr cgbuf (pop 1) Push0 AI_pop
@@ -10582,7 +10587,7 @@ and GenAttribArg amap (g: TcGlobals) eenv x (ilArgTy: ILType) =
else
string ilElemTy
- error (Error(FSComp.SR.ilCustomAttrInvalidArrayElemType elemTypeName, m))
+ error (RichError(FSComp.SR.ilCustomAttrInvalidArrayElemType (RichText.mkQualifiedTypeName elemTypeName), m))
else
ILAttribElem.Array(ilElemTy, List.map (fun arg -> GenAttribArg amap g eenv arg ilElemTy) args)
@@ -12171,8 +12176,11 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option
// Remove field suffix "@" for pretty printing
| None ->
errorR (
- Error(
- FSComp.SR.ilFieldDoesNotHaveValidOffsetForStructureLayout (tdef.Name, fdef.Name.Replace("@", "")),
+ RichError(
+ FSComp.SR.ilFieldDoesNotHaveValidOffsetForStructureLayout (
+ RichText.mkQualifiedTypeName tdef.Name,
+ RichText.mkField (fdef.Name.Replace("@", ""))
+ ),
(trimRangeToLine m)
)
)
diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs
index 7cce266b405..5ac76de3f79 100644
--- a/src/Compiler/Driver/CompilerDiagnostics.fs
+++ b/src/Compiler/Driver/CompilerDiagnostics.fs
@@ -637,7 +637,17 @@ let (|InvalidArgument|_|) (exn: exn) =
| :? ArgumentException as e -> ValueSome e.Message
| _ -> ValueNone
-let OutputNameSuggestions (os: StringBuilder) suggestNames suggestionsF idText =
+/// Classifies a name that failed to resolve. It stands for nothing, so it is not an entity of unknown
+/// kind but a name of its own kind.
+let richTextOfUnresolvedName name =
+ RichText.mkUnresolvedName (ConvertValLogicalNameToDisplayNameCore name)
+
+/// Classifies a name that does resolve but whose kind is not known here, e.g. one offered as a
+/// suggestion in place of a name that did not resolve
+let richTextOfNameOfUnknownKind name =
+ RichText.mkUnknownEntity (ConvertValLogicalNameToDisplayNameCore name)
+
+let OutputNameSuggestions (os: RichTextBuilder) suggestNames suggestionsF idText =
if suggestNames then
let buffer = DiagnosticResolutionHints.SuggestionBuffer idText
@@ -645,55 +655,55 @@ let OutputNameSuggestions (os: StringBuilder) suggestNames suggestionsF idText =
suggestionsF buffer.Add
if not buffer.IsEmpty then
- os.AppendString " "
- os.AppendString(FSComp.SR.undefinedNameSuggestionsIntro ())
+ os.Append " "
+ os.Append(FSComp.SR.undefinedNameSuggestionsIntro ())
for value in buffer do
- os.AppendLine() |> ignore
- os.AppendString " "
- os.AppendString(ConvertValLogicalNameToDisplayNameCore value)
+ os.Append(RichText.mkLineBreak Environment.NewLine)
+ os.Append " "
+ os.Append(richTextOfNameOfUnknownKind value)
-let OutputTypesNotInEqualityRelationContextInfo contextInfo ty1 ty2 m (os: StringBuilder) fallback =
+let OutputTypesNotInEqualityRelationContextInfo contextInfo (ty1: RichText) (ty2: RichText) m (os: RichTextBuilder) fallback =
match contextInfo with
- | ContextInfo.IfExpression range when equals range m -> os.AppendString(FSComp.SR.ifExpression (ty1, ty2))
+ | ContextInfo.IfExpression range when equals range m -> os.Append(FSComp.SR.ifExpression (ty1, ty2))
| ContextInfo.CollectionElement(isArray, range) when equals range m ->
if isArray then
- os.AppendString(FSComp.SR.arrayElementHasWrongType (ty1, ty2))
+ os.Append(FSComp.SR.arrayElementHasWrongType (ty1, ty2))
else
- os.AppendString(FSComp.SR.listElementHasWrongType (ty1, ty2))
- | ContextInfo.OmittedElseBranch range when equals range m -> os.AppendString(FSComp.SR.missingElseBranch ty2)
- | ContextInfo.ElseBranchResult range when equals range m -> os.AppendString(FSComp.SR.elseBranchHasWrongType (ty1, ty2))
+ os.Append(FSComp.SR.listElementHasWrongType (ty1, ty2))
+ | ContextInfo.OmittedElseBranch range when equals range m -> os.Append(FSComp.SR.missingElseBranch (ty2))
+ | ContextInfo.ElseBranchResult range when equals range m -> os.Append(FSComp.SR.elseBranchHasWrongType (ty1, ty2))
| ContextInfo.FollowingPatternMatchClause range when equals range m ->
- os.AppendString(FSComp.SR.followingPatternMatchClauseHasWrongType (ty1, ty2))
- | ContextInfo.PatternMatchGuard range when equals range m -> os.AppendString(FSComp.SR.patternMatchGuardIsNotBool ty2)
+ os.Append(FSComp.SR.followingPatternMatchClauseHasWrongType (ty1, ty2))
+ | ContextInfo.PatternMatchGuard range when equals range m -> os.Append(FSComp.SR.patternMatchGuardIsNotBool (ty2))
| contextInfo -> fallback contextInfo
type Exception with
- member exn.Output(os: StringBuilder, suggestNames) =
+ member exn.Output(os: RichTextBuilder, suggestNames) =
let typeEquationMessage g ty2 normalE tupleE = if isAnyTupleTy g ty2 then tupleE else normalE
match exn with
// TODO: this is now unused...?
| ConstraintSolverTupleDiffLengths(_, _, tl1, tl2, m, m2) ->
- os.AppendString(ConstraintSolverTupleDiffLengthsE().Format tl1.Length tl2.Length)
+ os.Append(ConstraintSolverTupleDiffLengthsE().Format tl1.Length tl2.Length)
if m.StartLine <> m2.StartLine then
- os.AppendString(SeeAlsoE().Format(stringOfRange m))
+ os.Append(SeeAlsoE().Format(stringOfRange m))
| ConstraintSolverInfiniteTypes(denv, contextInfo, ty1, ty2, m, m2) ->
// REVIEW: consider if we need to show _cxs (the type parameter constraints)
- let ty1, ty2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
- os.AppendString(ConstraintSolverInfiniteTypesE().Format ty1 ty2)
+ let ty1, ty2, _cxs = NicePrint.minimalRichTextsOfTwoTypes denv ty1 ty2
+ os.Append(ConstraintSolverInfiniteTypesE(), ty1, ty2)
match contextInfo with
- | ContextInfo.ReturnInComputationExpression -> os.AppendString(" " + FSComp.SR.returnUsedInsteadOfReturnBang ())
- | ContextInfo.YieldInComputationExpression -> os.AppendString(" " + FSComp.SR.yieldUsedInsteadOfYieldBang ())
+ | ContextInfo.ReturnInComputationExpression -> os.Append(" " + FSComp.SR.returnUsedInsteadOfReturnBang ())
+ | ContextInfo.YieldInComputationExpression -> os.Append(" " + FSComp.SR.yieldUsedInsteadOfYieldBang ())
| _ -> ()
if m.StartLine <> m2.StartLine then
- os.AppendString(SeeAlsoE().Format(stringOfRange m))
+ os.Append(SeeAlsoE().Format(stringOfRange m))
| ConstraintSolverNullnessWarningEquivWithTypes(denv, ty1, ty2, _nullness1, _nullness2, m, m2) ->
@@ -703,12 +713,12 @@ type Exception with
showNullnessAnnotations = Some true
}
- let t1, _t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
+ let t1, _t2, _cxs = NicePrint.minimalRichTextsOfTwoTypes denv ty1 ty2
- os.Append(ConstraintSolverNullnessWarningEquivWithTypesE().Format t1) |> ignore
+ os.Append(ConstraintSolverNullnessWarningEquivWithTypesE(), t1)
if m.StartLine <> m2.StartLine then
- os.Append(SeeAlsoE().Format(stringOfRange m)) |> ignore
+ os.Append(SeeAlsoE().Format(stringOfRange m))
| ConstraintSolverNullnessWarningWithTypes(denv, ty1, ty2, _nullness1, _nullness2, m, m2) ->
@@ -718,12 +728,12 @@ type Exception with
showNullnessAnnotations = Some true
}
- let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
+ let t1, t2, _cxs = NicePrint.minimalRichTextsOfTwoTypes denv ty1 ty2
- os.Append(ConstraintSolverNullnessWarningWithTypesE().Format t1 t2) |> ignore
+ os.Append(ConstraintSolverNullnessWarningWithTypesE(), t1, t2)
if m.StartLine <> m2.StartLine || m.EndLine <> m2.EndLine then
- os.Append(SeeAlsoE().Format(stringOfRange m)) |> ignore
+ os.Append(SeeAlsoE().Format(stringOfRange m))
| ConstraintSolverNullnessWarningWithType(denv, ty, _, m, m2) ->
@@ -733,66 +743,67 @@ type Exception with
showNullnessAnnotations = Some true
}
- let t = NicePrint.minimalStringOfType denv ty
- os.Append(ConstraintSolverNullnessWarningWithTypeE().Format(t)) |> ignore
+ os.Append(ConstraintSolverNullnessWarningWithTypeE(), NicePrint.minimalRichTextOfType denv ty)
if m.StartLine <> m2.StartLine || m.EndLine <> m2.EndLine then
- os.Append(SeeAlsoE().Format(stringOfRange m)) |> ignore
+ os.Append(SeeAlsoE().Format(stringOfRange m))
| ConstraintSolverNullnessWarningOnDotAccess(denv, objTy, memberName, bindingName, m, m2) ->
- let tyStr = NicePrint.minimalStringOfTypeWithNullness denv objTy
+ let tyText = NicePrint.minimalRichTextOfTypeWithNullness denv objTy
match bindingName with
| Some name ->
- os.Append(ConstraintSolverNullnessWarningOnDotAccessWithBindingE().Format memberName name tyStr)
- |> ignore
- | None ->
- os.Append(ConstraintSolverNullnessWarningOnDotAccessE().Format memberName tyStr)
- |> ignore
+ os.Append(
+ ConstraintSolverNullnessWarningOnDotAccessWithBindingE(),
+ RichText.mkMember memberName,
+ RichText.mkLocal name,
+ tyText
+ )
+ | None -> os.Append(ConstraintSolverNullnessWarningOnDotAccessE(), RichText.mkMember memberName, tyText)
if m.StartLine <> m2.StartLine || m.EndLine <> m2.EndLine then
- os.Append(SeeAlsoE().Format(stringOfRange m2)) |> ignore
+ os.Append(SeeAlsoE().Format(stringOfRange m2))
else
- os.Append(".") |> ignore
+ os.Append(".")
| ConstraintSolverNullnessWarning(msg, m, m2) ->
- os.Append(ConstraintSolverNullnessWarningE().Format(msg)) |> ignore
+ os.Append(ConstraintSolverNullnessWarningE(), msg)
if m.StartLine <> m2.StartLine then
- os.AppendString(SeeAlsoE().Format(stringOfRange m2))
+ os.Append(SeeAlsoE().Format(stringOfRange m2))
| ConstraintSolverMissingConstraint(denv, tpr, tpc, m, m2) ->
- os.AppendString(ConstraintSolverMissingConstraintE().Format(NicePrint.stringOfTyparConstraint denv (tpr, tpc)))
+ os.Append(ConstraintSolverMissingConstraintE(), NicePrint.richTextOfTyparConstraint denv (tpr, tpc))
if m.StartLine <> m2.StartLine then
- os.AppendString(SeeAlsoE().Format(stringOfRange m))
+ os.Append(SeeAlsoE().Format(stringOfRange m))
| ConstraintSolverTypesNotInEqualityRelation(denv, ty1, ty2, m, m2, contextInfo) ->
// REVIEW: consider if we need to show _cxs (the type parameter constraints)
- let ty1str, ty2str, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
+ let ty1Text, ty2Text, _cxs = NicePrint.minimalRichTextsOfTwoTypes denv ty1 ty2
match ty1, ty2 with
- | TType_measure _, TType_measure _ -> os.AppendString(ConstraintSolverTypesNotInEqualityRelation1E().Format ty1str ty2str)
+ | TType_measure _, TType_measure _ -> os.Append(ConstraintSolverTypesNotInEqualityRelation1E(), ty1Text, ty2Text)
| _ ->
- OutputTypesNotInEqualityRelationContextInfo contextInfo ty1str ty2str m os (fun _ ->
- os.AppendString(ConstraintSolverTypesNotInEqualityRelation2E().Format ty1str ty2str))
+ OutputTypesNotInEqualityRelationContextInfo contextInfo ty1Text ty2Text m os (fun _ ->
+ os.Append(ConstraintSolverTypesNotInEqualityRelation2E(), ty1Text, ty2Text))
if m.StartLine <> m2.StartLine then
- os.AppendString(SeeAlsoE().Format(stringOfRange m))
+ os.Append(SeeAlsoE().Format(stringOfRange m))
| ConstraintSolverTypesNotInSubsumptionRelation(denv, ty1, ty2, m, m2) ->
// REVIEW: consider if we need to show _cxs (the type parameter constraints)
- let ty1, ty2, cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
- os.AppendString(ConstraintSolverTypesNotInSubsumptionRelationE().Format ty2 ty1 cxs)
+ let ty1, ty2, cxs = NicePrint.minimalRichTextsOfTwoTypes denv ty1 ty2
+ os.Append(ConstraintSolverTypesNotInSubsumptionRelationE(), ty2, ty1, cxs)
if m.StartLine <> m2.StartLine then
- os.AppendString(SeeAlsoE().Format(stringOfRange m2))
+ os.Append(SeeAlsoE().Format(stringOfRange m2))
| ConstraintSolverError(msg, m, m2) ->
- os.AppendString msg
+ os.Append msg
if m.StartLine <> m2.StartLine then
- os.AppendString(SeeAlsoE().Format(stringOfRange m2))
+ os.Append(SeeAlsoE().Format(stringOfRange m2))
| ErrorFromAddingTypeEquation(g, denv, ty1, ty2, ConstraintSolverTypesNotInEqualityRelation(_, ty1b, ty2b, m, _, contextInfo), _) when
typeEquiv g ty1 ty1b && typeEquiv g ty2 ty2b
@@ -800,17 +811,17 @@ type Exception with
let typeEquation1E =
typeEquationMessage g ty2 ErrorFromAddingTypeEquation1E ErrorFromAddingTypeEquation1TupleE
- let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
+ let ty1, ty2, tpcs = NicePrint.minimalRichTextsOfTwoTypes denv ty1 ty2
OutputTypesNotInEqualityRelationContextInfo contextInfo ty1 ty2 m os (fun contextInfo ->
match contextInfo with
| ContextInfo.TupleInRecordFields ->
- os.AppendString(typeEquation1E().Format ty2 ty1 tpcs)
- os.AppendString(Environment.NewLine + FSComp.SR.commaInsteadOfSemicolonInRecord ())
- | _ when ty2 = "bool" && ty1.EndsWithOrdinal(" ref") ->
- os.AppendString(typeEquation1E().Format ty2 ty1 tpcs)
- os.AppendString(Environment.NewLine + FSComp.SR.derefInsteadOfNot ())
- | _ -> os.AppendString(typeEquation1E().Format ty2 ty1 tpcs))
+ os.Append(typeEquation1E (), ty2, ty1, tpcs)
+ os.Append(Environment.NewLine + FSComp.SR.commaInsteadOfSemicolonInRecord ())
+ | _ when ty2.Text = "bool" && ty1.Text.EndsWithOrdinal(" ref") ->
+ os.Append(typeEquation1E (), ty2, ty1, tpcs)
+ os.Append(Environment.NewLine + FSComp.SR.derefInsteadOfNot ())
+ | _ -> os.Append(typeEquation1E (), ty2, ty1, tpcs))
| ErrorFromAddingTypeEquation(_, _, _, _, (ConstraintSolverTypesNotInEqualityRelation(_, _, _, _, _, contextInfo) as e), _) when
(match contextInfo with
@@ -826,27 +837,30 @@ type Exception with
| ErrorFromAddingTypeEquation(error = ConstraintSolverError _ as e) -> e.Output(os, suggestNames)
| ErrorFromAddingTypeEquation(_g, denv, ty1, ty2, ConstraintSolverTupleDiffLengths(_, contextInfo, tl1, tl2, m1, m2), m) ->
- let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
- let messageArgs = tl1.Length, ty1, tl2.Length, ty2
+ let ty1, ty2, tpcs = NicePrint.minimalRichTextsOfTwoTypes denv ty1 ty2
+
+ let tupleLengthsMessage (message: int * RichText * int * RichText -> RichText) = message (tl1.Length, ty1, tl2.Length, ty2)
- if ty1 <> ty2 + tpcs then
+ if ty1.Text <> ty2.Text + tpcs.Text then
match contextInfo with
- | ContextInfo.IfExpression range when equals range m -> os.AppendString(FSComp.SR.ifExpressionTuple messageArgs)
+ | ContextInfo.IfExpression range when equals range m -> os.Append(tupleLengthsMessage FSComp.SR.ifExpressionTuple)
| ContextInfo.ElseBranchResult range when equals range m ->
- os.AppendString(FSComp.SR.elseBranchHasWrongTypeTuple messageArgs)
+ os.Append(tupleLengthsMessage FSComp.SR.elseBranchHasWrongTypeTuple)
| ContextInfo.FollowingPatternMatchClause range when equals range m ->
- os.AppendString(FSComp.SR.followingPatternMatchClauseHasWrongTypeTuple messageArgs)
+ os.Append(tupleLengthsMessage FSComp.SR.followingPatternMatchClauseHasWrongTypeTuple)
| ContextInfo.CollectionElement(isArray, range) when equals range m ->
if isArray then
- os.AppendString(FSComp.SR.arrayElementHasWrongTypeTuple messageArgs)
+ os.Append(tupleLengthsMessage FSComp.SR.arrayElementHasWrongTypeTuple)
else
- os.AppendString(FSComp.SR.listElementHasWrongTypeTuple messageArgs)
- | _ -> os.AppendString(ErrorFromAddingTypeEquationTuplesE().Format tl1.Length ty1 tl2.Length ty2 tpcs)
+ os.Append(tupleLengthsMessage FSComp.SR.listElementHasWrongTypeTuple)
+ | _ ->
+ os.Append(fun rich ->
+ ErrorFromAddingTypeEquationTuplesE().Format tl1.Length (rich ty1) tl2.Length (rich ty2) (rich tpcs))
else
- os.AppendString(ConstraintSolverTupleDiffLengthsE().Format tl1.Length tl2.Length)
+ os.Append(ConstraintSolverTupleDiffLengthsE().Format tl1.Length tl2.Length)
if m1.StartLine <> m2.StartLine then
- os.AppendString(SeeAlsoE().Format(stringOfRange m1))
+ os.Append(SeeAlsoE().Format(stringOfRange m1))
| ErrorFromAddingTypeEquation(g, denv, ty1, ty2, e, _) ->
let typeEquation2E =
@@ -854,10 +868,10 @@ type Exception with
let e =
if not (typeEquiv g ty1 ty2) then
- let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
+ let ty1, ty2, tpcs = NicePrint.minimalRichTextsOfTwoTypes denv ty1 ty2
- if ty1 <> ty2 + tpcs then
- os.AppendString(typeEquation2E().Format ty1 ty2 tpcs)
+ if ty1.Text <> ty2.Text + tpcs.Text then
+ os.Append(typeEquation2E (), ty1, ty2, tpcs)
e
@@ -876,36 +890,35 @@ type Exception with
e.Output(os, suggestNames)
| ErrorFromApplyingDefault(_, denv, _, defaultType, e, _) ->
- let defaultType = NicePrint.minimalStringOfType denv defaultType
- os.AppendString(ErrorFromApplyingDefault1E().Format defaultType)
+ os.Append(ErrorFromApplyingDefault1E(), NicePrint.minimalRichTextOfType denv defaultType)
e.Output(os, suggestNames)
- os.AppendString(ErrorFromApplyingDefault2E().Format)
+ os.Append(ErrorFromApplyingDefault2E().Format)
| ErrorsFromAddingSubsumptionConstraint(g, denv, ty1, ty2, e, contextInfo, _) ->
match contextInfo with
| ContextInfo.DowncastUsedInsteadOfUpcast isOperator ->
- let ty1, ty2, _ = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
+ let ty1, ty2, _ = NicePrint.minimalRichTextsOfTwoTypes denv ty1 ty2
if isOperator then
- os.AppendString(FSComp.SR.considerUpcastOperator (ty1, ty2) |> snd)
+ os.Append(snd (FSComp.SR.considerUpcastOperator (ty1, ty2)))
else
- os.AppendString(FSComp.SR.considerUpcast (ty1, ty2) |> snd)
+ os.Append(snd (FSComp.SR.considerUpcast (ty1, ty2)))
| _ ->
if not (typeEquiv g ty1 ty2) then
- let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
+ let ty1, ty2, tpcs = NicePrint.minimalRichTextsOfTwoTypes denv ty1 ty2
- if ty1 <> (ty2 + tpcs) then
- os.AppendString(ErrorsFromAddingSubsumptionConstraintE().Format ty2 ty1 tpcs)
+ if ty1.Text <> ty2.Text + tpcs.Text then
+ os.Append(ErrorsFromAddingSubsumptionConstraintE(), ty2, ty1, tpcs)
else
e.Output(os, suggestNames)
else
e.Output(os, suggestNames)
- | UpperCaseIdentifierInPattern _ -> os.AppendString(UpperCaseIdentifierInPatternE().Format)
+ | UpperCaseIdentifierInPattern _ -> os.Append(UpperCaseIdentifierInPatternE().Format)
- | NotUpperCaseConstructor _ -> os.AppendString(NotUpperCaseConstructorE().Format)
+ | NotUpperCaseConstructor _ -> os.Append(NotUpperCaseConstructorE().Format)
- | NotUpperCaseConstructorWithoutRQA _ -> os.AppendString(NotUpperCaseConstructorWithoutRQAE().Format)
+ | NotUpperCaseConstructorWithoutRQA _ -> os.Append(NotUpperCaseConstructorWithoutRQAE().Format)
| ErrorFromAddingConstraint(_, e, _) -> e.Output(os, suggestNames)
@@ -914,7 +927,7 @@ type Exception with
| TypeProviders.ProvidedTypeResolution(_, e) -> e.Output(os, suggestNames)
- | :? TypeProviderError as e -> os.AppendString(e.ContextualErrorMessage)
+ | :? TypeProviderError as e -> os.Append(e.ContextualErrorRichMessage)
#endif
| UnresolvedOverloading(denv, callerArgs, failure, m) ->
@@ -949,16 +962,16 @@ type Exception with
NicePrint.prettyLayoutsOfUnresolvedOverloading denv argRepr retTy genericParameterTypes
match callerArgs.ArgumentNamesAndTypes with
- | [] -> None, LayoutRender.showL retTyL, LayoutRender.showL genParamTysL
+ | [] -> None, LayoutRender.toRichText retTyL, LayoutRender.toRichText genParamTysL
| items ->
- let args = LayoutRender.showL argsL
+ let args = LayoutRender.toRichText argsL
- let prefixMessage =
+ let prefixMessage: RichText -> RichText =
match items with
| [ _ ] -> FSComp.SR.csNoOverloadsFoundArgumentsPrefixSingular
| _ -> FSComp.SR.csNoOverloadsFoundArgumentsPrefixPlural
- Some(prefixMessage args), LayoutRender.showL retTyL, LayoutRender.showL genParamTysL
+ Some(prefixMessage args), LayoutRender.toRichText retTyL, LayoutRender.toRichText genParamTysL
let knownReturnType =
match knownReturnType with
@@ -977,157 +990,175 @@ type Exception with
| :? ArgDoesNotMatchError as x ->
let nameOrOneBasedIndexMessage =
x.calledArg.NameOpt
- |> Option.map (fun n -> FSComp.SR.csOverloadCandidateNamedArgumentTypeMismatch n.idText)
+ |> Option.map (fun n -> FSComp.SR.csOverloadCandidateNamedArgumentTypeMismatch (RichText.mkParameter n.idText))
|> Option.defaultValue (
- FSComp.SR.csOverloadCandidateIndexedArgumentTypeMismatch ((vsnd x.calledArg.Position) + 1)
+ RichText.mkText (FSComp.SR.csOverloadCandidateIndexedArgumentTypeMismatch ((vsnd x.calledArg.Position) + 1))
) //snd
- sprintf " // %s" nameOrOneBasedIndexMessage
- | _ -> ""
+ RichText.append (RichText.mkText " // ") nameOrOneBasedIndexMessage
+ | _ -> RichText.empty
- (NicePrint.stringOfMethInfoForOverloadError x.infoReader m displayEnv x.methodSlot.Method)
- + paramInfo
+ RichText.append (NicePrint.richTextOfMethInfoForOverloadError x.infoReader m displayEnv x.methodSlot.Method) paramInfo
let nl = Environment.NewLine
let formatOverloads (overloads: OverloadInformation list) =
overloads
|> List.map (overloadMethodInfo denv m)
- |> List.sort
+ |> List.sortBy (fun overload -> overload.Text)
|> List.map FSComp.SR.formatDashItem
- |> String.concat nl
+ |> RichText.concatWith (RichText.mkText nl)
// assemble final message composing the parts
let msg =
let optionalParts =
- [ knownReturnType; genericParametersMessage; argsMessage ]
- |> List.choose id
- |> String.concat (nl + nl)
- |> fun result ->
- if String.IsNullOrEmpty(result) then
- nl
- else
- nl + nl + result + nl + nl
+ let result =
+ [ knownReturnType; genericParametersMessage; argsMessage ]
+ |> List.choose id
+ |> RichText.concatWith (RichText.mkText (nl + nl))
+
+ if result.IsEmpty then
+ RichText.mkText nl
+ else
+ RichText.concat [ RichText.mkText (nl + nl); result; RichText.mkText (nl + nl) ]
match failure with
| NoOverloadsFound(methodName, overloads, _) ->
- FSComp.SR.csNoOverloadsFound methodName
- + optionalParts
- + (FSComp.SR.csAvailableOverloads (formatOverloads overloads))
- | PossibleCandidates(methodName, [], _) -> FSComp.SR.csMethodIsOverloaded methodName
+ RichText.concat
+ [
+ FSComp.SR.csNoOverloadsFound (RichText.mkMethod methodName)
+ optionalParts
+ FSComp.SR.csAvailableOverloads (formatOverloads overloads)
+ ]
+ | PossibleCandidates(methodName, [], _) -> FSComp.SR.csMethodIsOverloaded (RichText.mkMethod methodName)
| PossibleCandidates(methodName, overloads, _) ->
- FSComp.SR.csMethodIsOverloaded methodName
- + optionalParts
- + FSComp.SR.csCandidates (formatOverloads overloads)
+ RichText.concat
+ [
+ FSComp.SR.csMethodIsOverloaded (RichText.mkMethod methodName)
+ optionalParts
+ FSComp.SR.csCandidates (formatOverloads overloads)
+ ]
- os.AppendString msg
+ os.Append msg
| UnresolvedConversionOperator(denv, fromTy, toTy, _) ->
- let ty1, ty2, _tpcs = NicePrint.minimalStringsOfTwoTypes denv fromTy toTy
- os.AppendString(FSComp.SR.csTypeDoesNotSupportConversion (ty1, ty2))
+ let ty1, ty2, _tpcs = NicePrint.minimalRichTextsOfTwoTypes denv fromTy toTy
+ os.Append(FSComp.SR.csTypeDoesNotSupportConversion (ty1, ty2))
- | FunctionExpected _ -> os.AppendString(FunctionExpectedE().Format)
+ | FunctionExpected _ -> os.Append(FunctionExpectedE().Format)
- | BakedInMemberConstraintName(nm, _) -> os.AppendString(BakedInMemberConstraintNameE().Format nm)
+ | BakedInMemberConstraintName(nm, _) -> os.Append(BakedInMemberConstraintNameE(), RichText.mkMember nm)
- | StandardOperatorRedefinitionWarning(msg, _) -> os.AppendString msg
+ | StandardOperatorRedefinitionWarning(msg, _) -> os.Append msg
- | BadEventTransformation _ -> os.AppendString(BadEventTransformationE().Format)
+ | BadEventTransformation _ -> os.Append(BadEventTransformationE().Format)
- | ParameterlessStructCtor _ -> os.AppendString(ParameterlessStructCtorE().Format)
+ | ParameterlessStructCtor _ -> os.Append(ParameterlessStructCtorE().Format)
- | InterfaceNotRevealed(denv, intfTy, _) ->
- os.AppendString(InterfaceNotRevealedE().Format(NicePrint.minimalStringOfType denv intfTy))
+ | InterfaceNotRevealed(denv, intfTy, _) -> os.Append(InterfaceNotRevealedE(), NicePrint.minimalRichTextOfType denv intfTy)
| NotAFunctionButIndexer(_, _, name, _, _, old) ->
if old then
match name with
- | Some name -> os.AppendString(FSComp.SR.notAFunctionButMaybeIndexerWithName name)
- | _ -> os.AppendString(FSComp.SR.notAFunctionButMaybeIndexer ())
+ | Some name -> os.Append(FSComp.SR.notAFunctionButMaybeIndexerWithName (RichText.mkLocal name))
+ | _ -> os.Append(FSComp.SR.notAFunctionButMaybeIndexer ())
else
match name with
- | Some name -> os.AppendString(FSComp.SR.notAFunctionButMaybeIndexerWithName2 name)
- | _ -> os.AppendString(FSComp.SR.notAFunctionButMaybeIndexer2 ())
+ | Some name -> os.Append(FSComp.SR.notAFunctionButMaybeIndexerWithName2 (RichText.mkLocal name))
+ | _ -> os.Append(FSComp.SR.notAFunctionButMaybeIndexer2 ())
| NotAFunction(denv, ty, _, marg) ->
if marg.StartColumn = 0 then
- os.AppendString(FSComp.SR.notAFunctionButMaybeDeclaration ())
+ os.Append(FSComp.SR.notAFunctionButMaybeDeclaration ())
elif isTyparTy denv.g ty then
- os.AppendString(FSComp.SR.notAFunction ())
+ os.Append(FSComp.SR.notAFunction ())
else
- os.AppendString(FSComp.SR.notAFunctionWithType (NicePrint.prettyStringOfTy denv ty))
+ os.Append(FSComp.SR.notAFunctionWithType (NicePrint.prettyRichTextOfTy denv ty))
| TyconBadArgs(_, tcref, d, _) ->
let exp = tcref.Typars.Length
if exp = 0 then
- os.AppendString(FSComp.SR.buildUnexpectedTypeArgs (fullDisplayTextOfTyconRef tcref, d))
+ os.Append(FSComp.SR.buildUnexpectedTypeArgs (richTextOfQualifiedTyconRef tcref, d))
else
- os.AppendString(TyconBadArgsE().Format (fullDisplayTextOfTyconRef tcref) exp d)
+ os.Append(fun rich -> TyconBadArgsE().Format (rich (richTextOfQualifiedTyconRef tcref)) exp d)
- | IndeterminateType _ -> os.AppendString(IndeterminateTypeE().Format)
+ | IndeterminateType _ -> os.Append(IndeterminateTypeE().Format)
| NameClash(nm, k1, nm1, _, k2, nm2, _) ->
if nm = nm1 && nm1 = nm2 && k1 = k2 then
- os.AppendString(NameClash1E().Format k1 nm1)
+ os.Append(NameClash1E(), RichText.mkText k1, richTextOfNameOfUnknownKind nm1)
else
- os.AppendString(NameClash2E().Format k1 nm1 nm k2 nm2)
+ os.Append(fun rich ->
+ NameClash2E().Format
+ k1
+ (rich (richTextOfNameOfUnknownKind nm1))
+ (rich (richTextOfNameOfUnknownKind nm))
+ k2
+ (rich (richTextOfNameOfUnknownKind nm2)))
| Duplicate(k, s, _) ->
if k = "member" then
- os.AppendString(Duplicate1E().Format(ConvertValLogicalNameToDisplayNameCore s))
+ os.Append(Duplicate1E(), RichText.mkMember (ConvertValLogicalNameToDisplayNameCore s))
else
- os.AppendString(Duplicate2E().Format k (ConvertValLogicalNameToDisplayNameCore s))
+ os.Append(Duplicate2E(), RichText.mkText k, richTextOfNameOfUnknownKind s)
| UndefinedName(_, k, id, suggestionsF) ->
- os.AppendString(k (ConvertValLogicalNameToDisplayNameCore id.idText))
+ os.Append(k (richTextOfUnresolvedName id.idText))
OutputNameSuggestions os suggestNames suggestionsF id.idText
| InternalUndefinedItemRef(f, smr, ccuName, s) ->
let _, errs = f (smr, ccuName, s)
- os.AppendString errs
+ os.Append errs
- | FieldNotMutable _ -> os.AppendString(FieldNotMutableE().Format)
+ | FieldNotMutable _ -> os.Append(FieldNotMutableE().Format)
| FieldsFromDifferentTypes(_, fref1, fref2, _) ->
- os.AppendString(FieldsFromDifferentTypesE().Format fref1.FieldName fref2.FieldName)
+ os.Append(FieldsFromDifferentTypesE(), RichText.mkRecordField fref1.FieldName, RichText.mkRecordField fref2.FieldName)
- | VarBoundTwice id -> os.AppendString(VarBoundTwiceE().Format(ConvertValLogicalNameToDisplayNameCore id.idText))
+ | VarBoundTwice id -> os.Append(VarBoundTwiceE(), RichText.mkLocal (ConvertValLogicalNameToDisplayNameCore id.idText))
| Recursion(denv, id, ty1, ty2, _) ->
- let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
- os.AppendString(RecursionE().Format (ConvertValLogicalNameToDisplayNameCore id.idText) ty1 ty2 tpcs)
+ let ty1, ty2, tpcs = NicePrint.minimalRichTextsOfTwoTypes denv ty1 ty2
+
+ let name = RichText.mkFunction (ConvertValLogicalNameToDisplayNameCore id.idText)
+
+ os.Append(RecursionE(), name, ty1, ty2, tpcs)
| InvalidRuntimeCoercion(denv, ty1, ty2, _) ->
- let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
- os.AppendString(InvalidRuntimeCoercionE().Format ty1 ty2 tpcs)
+ let ty1, ty2, tpcs = NicePrint.minimalRichTextsOfTwoTypes denv ty1 ty2
+ os.Append(InvalidRuntimeCoercionE(), ty1, ty2, tpcs)
| IndeterminateRuntimeCoercion(denv, ty1, ty2, _) ->
- let ty1, ty2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
- os.AppendString(IndeterminateRuntimeCoercionE().Format ty1 ty2)
+ let ty1, ty2, _cxs = NicePrint.minimalRichTextsOfTwoTypes denv ty1 ty2
+ os.Append(IndeterminateRuntimeCoercionE(), ty1, ty2)
| IndeterminateStaticCoercion(denv, ty1, ty2, _) ->
// REVIEW: consider if we need to show _cxs (the type parameter constraints)
- let ty1, ty2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
- os.AppendString(IndeterminateStaticCoercionE().Format ty1 ty2)
+ let ty1, ty2, _cxs = NicePrint.minimalRichTextsOfTwoTypes denv ty1 ty2
+ os.Append(IndeterminateStaticCoercionE(), ty1, ty2)
| StaticCoercionShouldUseBox(denv, ty1, ty2, _) ->
// REVIEW: consider if we need to show _cxs (the type parameter constraints)
- let ty1, ty2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
- os.AppendString(StaticCoercionShouldUseBoxE().Format ty1 ty2)
+ let ty1, ty2, _cxs = NicePrint.minimalRichTextsOfTwoTypes denv ty1 ty2
+ os.Append(StaticCoercionShouldUseBoxE(), ty1, ty2)
- | TypeIsImplicitlyAbstract _ -> os.AppendString(TypeIsImplicitlyAbstractE().Format)
+ | TypeIsImplicitlyAbstract _ -> os.Append(TypeIsImplicitlyAbstractE().Format)
| NonRigidTypar(denv, tpnmOpt, typarRange, ty1, ty2, _) ->
// REVIEW: consider if we need to show _cxs (the type parameter constraints)
let (ty1, ty2), _cxs = PrettyTypes.PrettifyTypePair denv.g (ty1, ty2)
+ let ty2 = NicePrint.richTextOfTy denv ty2
+
match tpnmOpt with
- | None -> os.AppendString(NonRigidTypar1E().Format (stringOfRange typarRange) (NicePrint.stringOfTy denv ty2))
+ | None -> os.Append(NonRigidTypar1E(), RichText.mkText (stringOfRange typarRange), ty2)
| Some tpnm ->
+ let tpnm = RichText.mkTypeParameter tpnm
+
match ty1 with
- | TType_measure _ -> os.AppendString(NonRigidTypar2E().Format tpnm (NicePrint.stringOfTy denv ty2))
- | _ -> os.AppendString(NonRigidTypar3E().Format tpnm (NicePrint.stringOfTy denv ty2))
+ | TType_measure _ -> os.Append(NonRigidTypar2E(), tpnm, ty2)
+ | _ -> os.Append(NonRigidTypar3E(), tpnm, ty2)
| SyntaxError(ctxt, _) ->
let ctxt = unbox> ctxt
@@ -1366,14 +1397,14 @@ type Exception with
#endif
match ctxt.CurrentToken with
- | None -> os.AppendString(UnexpectedEndOfInputE().Format)
+ | None -> os.Append(UnexpectedEndOfInputE().Format)
| Some token ->
let tokenId = token |> Parser.tagOfToken |> Parser.tokenTagToTokenId
match tokenId, token with
- | EndOfStructuredConstructToken, _ -> os.AppendString(OBlockEndSentenceE().Format)
- | Parser.TOKEN_LEX_FAILURE, Parser.LEX_FAILURE str -> os.AppendString str
- | token, _ -> os.AppendString(UnexpectedE().Format(token |> tokenIdToText))
+ | EndOfStructuredConstructToken, _ -> os.Append(OBlockEndSentenceE().Format)
+ | Parser.TOKEN_LEX_FAILURE, Parser.LEX_FAILURE str -> os.Append str
+ | token, _ -> os.Append(UnexpectedE().Format(token |> tokenIdToText))
// Search for a state producing a single recognized non-terminal in the states on the stack
let foundInContext =
@@ -1471,126 +1502,137 @@ type Exception with
match prodIds with
| [ Parser.NONTERM_interaction ] ->
- os.AppendString(NONTERM_interactionE().Format)
+ os.Append(NONTERM_interactionE().Format)
true
| [ Parser.NONTERM_hashDirective ] ->
- os.AppendString(NONTERM_hashDirectiveE().Format)
+ os.Append(NONTERM_hashDirectiveE().Format)
true
| [ Parser.NONTERM_fieldDecl ] ->
- os.AppendString(NONTERM_fieldDeclE().Format)
+ os.Append(NONTERM_fieldDeclE().Format)
true
| [ Parser.NONTERM_unionCaseRepr ] ->
- os.AppendString(NONTERM_unionCaseReprE().Format)
+ os.Append(NONTERM_unionCaseReprE().Format)
true
| [ Parser.NONTERM_localBinding ] ->
- os.AppendString(NONTERM_localBindingE().Format)
+ os.Append(NONTERM_localBindingE().Format)
true
| [ Parser.NONTERM_hardwhiteLetBindings ] ->
- os.AppendString(NONTERM_hardwhiteLetBindingsE().Format)
+ os.Append(NONTERM_hardwhiteLetBindingsE().Format)
true
| [ Parser.NONTERM_classDefnMember ] ->
- os.AppendString(NONTERM_classDefnMemberE().Format)
+ os.Append(NONTERM_classDefnMemberE().Format)
true
| [ Parser.NONTERM_defnBindings ] ->
- os.AppendString(NONTERM_defnBindingsE().Format)
+ os.Append(NONTERM_defnBindingsE().Format)
true
| [ Parser.NONTERM_classMemberSpfn ] ->
- os.AppendString(NONTERM_classMemberSpfnE().Format)
+ os.Append(NONTERM_classMemberSpfnE().Format)
true
| [ Parser.NONTERM_classMemberSpfnGetSetElements ] ->
- os.AppendString(NONTERM_classMemberSpfnGetSetElementsE().Format)
+ os.Append(NONTERM_classMemberSpfnGetSetElementsE().Format)
true
| [ Parser.NONTERM_autoPropsDefnDecl ] ->
- os.AppendString(NONTERM_autoPropsDefnDeclE().Format)
+ os.Append(NONTERM_autoPropsDefnDeclE().Format)
true
| [ Parser.NONTERM_valSpfn ] ->
- os.AppendString(NONTERM_valSpfnE().Format)
+ os.Append(NONTERM_valSpfnE().Format)
true
| [ Parser.NONTERM_tyconSpfn ] ->
- os.AppendString(NONTERM_tyconSpfnE().Format)
+ os.Append(NONTERM_tyconSpfnE().Format)
true
| [ Parser.NONTERM_anonLambdaExpr ] ->
- os.AppendString(NONTERM_anonLambdaExprE().Format)
+ os.Append(NONTERM_anonLambdaExprE().Format)
true
| [ Parser.NONTERM_attrUnionCaseDecl ] ->
- os.AppendString(NONTERM_attrUnionCaseDeclE().Format)
+ os.Append(NONTERM_attrUnionCaseDeclE().Format)
true
| [ Parser.NONTERM_cPrototype ] ->
- os.AppendString(NONTERM_cPrototypeE().Format)
+ os.Append(NONTERM_cPrototypeE().Format)
true
| [ Parser.NONTERM_objExpr | Parser.NONTERM_objectImplementationMembers ] ->
- os.AppendString(NONTERM_objectImplementationMembersE().Format)
+ os.Append(NONTERM_objectImplementationMembersE().Format)
true
| [ Parser.NONTERM_ifExprThen | Parser.NONTERM_ifExprElifs | Parser.NONTERM_ifExprCases ] ->
- os.AppendString(NONTERM_ifExprCasesE().Format)
+ os.Append(NONTERM_ifExprCasesE().Format)
true
| [ Parser.NONTERM_openDecl ] ->
- os.AppendString(NONTERM_openDeclE().Format)
+ os.Append(NONTERM_openDeclE().Format)
true
| [ Parser.NONTERM_fileModuleSpec ] ->
- os.AppendString(NONTERM_fileModuleSpecE().Format)
+ os.Append(NONTERM_fileModuleSpecE().Format)
true
| [ Parser.NONTERM_patternClauses ] ->
- os.AppendString(NONTERM_patternClausesE().Format)
+ os.Append(NONTERM_patternClausesE().Format)
true
| [ Parser.NONTERM_beginEndExpr ] ->
- os.AppendString(NONTERM_beginEndExprE().Format)
+ os.Append(NONTERM_beginEndExprE().Format)
true
| [ Parser.NONTERM_recdExpr ] ->
- os.AppendString(NONTERM_recdExprE().Format)
+ os.Append(NONTERM_recdExprE().Format)
true
| [ Parser.NONTERM_tyconDefn ] ->
- os.AppendString(NONTERM_tyconDefnE().Format)
+ os.Append(NONTERM_tyconDefnE().Format)
true
| [ Parser.NONTERM_exconCore ] ->
- os.AppendString(NONTERM_exconCoreE().Format)
+ os.Append(NONTERM_exconCoreE().Format)
true
| [ Parser.NONTERM_typeNameInfo ] ->
- os.AppendString(NONTERM_typeNameInfoE().Format)
+ os.Append(NONTERM_typeNameInfoE().Format)
true
| [ Parser.NONTERM_attributeList ] ->
- os.AppendString(NONTERM_attributeListE().Format)
+ os.Append(NONTERM_attributeListE().Format)
true
| [ Parser.NONTERM_quoteExpr ] ->
- os.AppendString(NONTERM_quoteExprE().Format)
+ os.Append(NONTERM_quoteExprE().Format)
true
| [ Parser.NONTERM_typeConstraint ] ->
- os.AppendString(NONTERM_typeConstraintE().Format)
+ os.Append(NONTERM_typeConstraintE().Format)
true
| [ NONTERM_Category_ImplementationFile ] ->
- os.AppendString(NONTERM_Category_ImplementationFileE().Format)
+ os.Append(NONTERM_Category_ImplementationFileE().Format)
true
| [ NONTERM_Category_Definition ] ->
- os.AppendString(NONTERM_Category_DefinitionE().Format)
+ os.Append(NONTERM_Category_DefinitionE().Format)
true
| [ NONTERM_Category_SignatureFile ] ->
- os.AppendString(NONTERM_Category_SignatureFileE().Format)
+ os.Append(NONTERM_Category_SignatureFileE().Format)
true
| [ NONTERM_Category_Pattern ] ->
- os.AppendString(NONTERM_Category_PatternE().Format)
+ os.Append(NONTERM_Category_PatternE().Format)
true
| [ NONTERM_Category_Expr ] ->
- os.AppendString(NONTERM_Category_ExprE().Format)
+ os.Append(NONTERM_Category_ExprE().Format)
true
| [ NONTERM_Category_Type ] ->
- os.AppendString(NONTERM_Category_TypeE().Format)
+ os.Append(NONTERM_Category_TypeE().Format)
true
| [ Parser.NONTERM_typeArgsActual ] ->
- os.AppendString(NONTERM_typeArgsActualE().Format)
+ os.Append(NONTERM_typeArgsActualE().Format)
true
| _ -> false)
#if DEBUG
if not foundInContext then
- Printf.bprintf
- os
- ". (no 'in' context found: %+A)"
- (List.mapSquared Parser.prodIdxToNonTerminal ctxt.ReducibleProductions)
+ os.Append(
+ sprintf ". (no 'in' context found: %+A)" (List.mapSquared Parser.prodIdxToNonTerminal ctxt.ReducibleProductions)
+ )
#else
foundInContext |> ignore // suppress unused variable warning in RELEASE
#endif
+ // tokenIdToText describes a token as a keyword, as a symbol, or by a category such as
+ // 'identifier'. The message drops that wording, so it is what tells us how to classify
+ // what is left of it.
let fix (s: string) =
- s.Replace(SR.GetString("FixKeyword"), "").Replace(SR.GetString("FixSymbol"), "").Replace(SR.GetString("FixReplace"), "")
+ let keyword = SR.GetString("FixKeyword")
+ let symbol = SR.GetString("FixSymbol")
+
+ let tag =
+ if s.Contains keyword then TextTag.Keyword
+ elif s.Contains symbol then TextTag.Punctuation
+ else TextTag.Text
+
+ s.Replace(keyword, "").Replace(symbol, "").Replace(SR.GetString("FixReplace"), "")
+ |> RichText.ofTag tag
let tokenNames =
ctxt.ShiftTokens
@@ -1605,10 +1647,10 @@ type Exception with
|> Set.toList
match tokenNames with
- | [ tokenName1 ] -> os.AppendString(TokenName1E().Format(fix tokenName1))
- | [ tokenName1; tokenName2 ] -> os.AppendString(TokenName1TokenName2E().Format (fix tokenName1) (fix tokenName2))
+ | [ tokenName1 ] -> os.Append(TokenName1E(), fix tokenName1)
+ | [ tokenName1; tokenName2 ] -> os.Append(TokenName1TokenName2E(), fix tokenName1, fix tokenName2)
| [ tokenName1; tokenName2; tokenName3 ] ->
- os.AppendString(TokenName1TokenName2TokenName3E().Format (fix tokenName1) (fix tokenName2) (fix tokenName3))
+ os.Append(TokenName1TokenName2TokenName3E(), fix tokenName1, fix tokenName2, fix tokenName3)
| _ -> ()
(*
Printf.bprintf os ".\n\n state = %A\n token = %A\n expect (shift) %A\n expect (reduce) %A\n prods=%A\n non terminals: %A"
@@ -1625,26 +1667,26 @@ type Exception with
let ty, _cxs = PrettyTypes.PrettifyType denv.g ty
if isTyparTy denv.g ty then
- os.AppendString(RuntimeCoercionSourceSealed1E().Format(NicePrint.stringOfTy denv ty))
+ os.Append(RuntimeCoercionSourceSealed1E(), NicePrint.richTextOfTy denv ty)
else
- os.AppendString(RuntimeCoercionSourceSealed2E().Format(NicePrint.stringOfTy denv ty))
+ os.Append(RuntimeCoercionSourceSealed2E(), NicePrint.richTextOfTy denv ty)
| CoercionTargetSealed(denv, ty, _) ->
// REVIEW: consider if we need to show _cxs (the type parameter constraints)
let ty, _cxs = PrettyTypes.PrettifyType denv.g ty
- os.AppendString(CoercionTargetSealedE().Format(NicePrint.stringOfTy denv ty))
+ os.Append(CoercionTargetSealedE(), NicePrint.richTextOfTy denv ty)
- | UpcastUnnecessary _ -> os.AppendString(UpcastUnnecessaryE().Format)
+ | UpcastUnnecessary _ -> os.Append(UpcastUnnecessaryE().Format)
- | TypeTestUnnecessary _ -> os.AppendString(TypeTestUnnecessaryE().Format)
+ | TypeTestUnnecessary _ -> os.Append(TypeTestUnnecessaryE().Format)
- | QuotationTranslator.IgnoringPartOfQuotedTermWarning(msg, _) -> Printf.bprintf os "%s" msg
+ | QuotationTranslator.IgnoringPartOfQuotedTermWarning(msg, _) -> os.Append msg
| OverrideDoesntOverride(denv, impl, minfoVirtOpt, g, amap, m) ->
let sig1 = DispatchSlotChecking.FormatOverride denv impl
match minfoVirtOpt with
- | None -> os.AppendString(OverrideDoesntOverride1E().Format sig1)
+ | None -> os.Append(OverrideDoesntOverride1E(), sig1)
| Some minfoVirt ->
// https://github.com/dotnet/fsharp/issues/35
// Improve error message when attempting to override generic return type with unit:
@@ -1661,150 +1703,143 @@ type Exception with
match minfoVirt.ApparentEnclosingType with
| TType_app(tycon, tyargs, _) when tycon.IsFSharpInterfaceTycon && hasUnitTType_app tyargs ->
// match abstract member with 'unit' passed as generic argument
- os.AppendString(OverrideDoesntOverride4E().Format sig1)
+ os.Append(OverrideDoesntOverride4E(), sig1)
| _ ->
- os.AppendString(OverrideDoesntOverride2E().Format sig1)
+ os.Append(OverrideDoesntOverride2E(), sig1)
let sig2 = DispatchSlotChecking.FormatMethInfoSig g amap m denv minfoVirt
if sig1 <> sig2 then
- os.AppendString(OverrideDoesntOverride3E().Format sig2)
+ os.Append(OverrideDoesntOverride3E(), sig2)
// If implementation and required slot doesn't have same "instance-ness", then tell user that.
if impl.IsInstance <> minfoVirt.IsInstance then
// Required slot is instance, meaning implementation is static, tell user that we expect instance.
if minfoVirt.IsInstance then
- os.AppendString(OverrideShouldBeStatic().Format)
+ os.Append(OverrideShouldBeStatic().Format)
else
- os.AppendString(OverrideShouldBeInstance().Format)
+ os.Append(OverrideShouldBeInstance().Format)
- | UnionCaseWrongArguments(_, n1, n2, _) -> os.AppendString(UnionCaseWrongArgumentsE().Format n2 n1)
+ | UnionCaseWrongArguments(_, n1, n2, _) -> os.Append(UnionCaseWrongArgumentsE().Format n2 n1)
- | UnionPatternsBindDifferentNames _ -> os.AppendString(UnionPatternsBindDifferentNamesE().Format)
+ | UnionPatternsBindDifferentNames _ -> os.Append(UnionPatternsBindDifferentNamesE().Format)
| ValueNotContained(_, denv, infoReader, mref, implVal, sigVal, f) ->
let text1, text2 =
- NicePrint.minimalStringsOfTwoValues denv infoReader (mkLocalValRef implVal) (mkLocalValRef sigVal)
+ NicePrint.minimalRichTextsOfTwoValues denv infoReader (mkLocalValRef implVal) (mkLocalValRef sigVal)
- os.AppendString(f ((fullDisplayTextOfModRef mref), text1, text2))
+ os.Append(f (richTextOfQualifiedModRef mref, text1, text2))
| UnionCaseNotContained(denv, infoReader, enclosingTycon, v1, v2, f) ->
let enclosingTcref = mkLocalEntityRef enclosingTycon
- os.AppendString(
+ os.Append(
f (
- (NicePrint.stringOfUnionCase denv infoReader enclosingTcref v1),
- (NicePrint.stringOfUnionCase denv infoReader enclosingTcref v2)
+ (NicePrint.richTextOfUnionCase denv infoReader enclosingTcref v1),
+ (NicePrint.richTextOfUnionCase denv infoReader enclosingTcref v2)
)
)
| FSharpExceptionNotContained(denv, infoReader, v1, v2, f) ->
- os.AppendString(
+ os.Append(
f (
- (NicePrint.stringOfExnDef denv infoReader (mkLocalEntityRef v1)),
- (NicePrint.stringOfExnDef denv infoReader (mkLocalEntityRef v2))
+ (NicePrint.richTextOfExnDef denv infoReader (mkLocalEntityRef v1)),
+ (NicePrint.richTextOfExnDef denv infoReader (mkLocalEntityRef v2))
)
)
| FieldNotContained(_, denv, infoReader, enclosingTycon, _, v1, v2, f) ->
let enclosingTcref = mkLocalEntityRef enclosingTycon
- os.AppendString(
+ os.Append(
f (
- (NicePrint.stringOfRecdField denv infoReader enclosingTcref v1),
- (NicePrint.stringOfRecdField denv infoReader enclosingTcref v2)
+ (NicePrint.richTextOfRecdField denv infoReader enclosingTcref v1),
+ (NicePrint.richTextOfRecdField denv infoReader enclosingTcref v2)
)
)
| RequiredButNotSpecified(_, mref, k, name, _) ->
- let nsb = StringBuilder()
+ let nsb = RichTextBuilder()
name nsb
- os.AppendString(RequiredButNotSpecifiedE().Format (fullDisplayTextOfModRef mref) k (nsb.ToString()))
- | UseOfAddressOfOperator _ -> os.AppendString(UseOfAddressOfOperatorE().Format)
+ os.Append(RequiredButNotSpecifiedE(), richTextOfQualifiedModRef mref, RichText.mkText k, nsb.ToRichText())
+
+ | UseOfAddressOfOperator _ -> os.Append(UseOfAddressOfOperatorE().Format)
- | DefensiveCopyWarning(s, _) -> os.AppendString(DefensiveCopyWarningE().Format s)
+ | DefensiveCopyWarning(s, _) -> os.Append(DefensiveCopyWarningE().Format s)
- | DeprecatedThreadStaticBindingWarning _ -> os.AppendString(DeprecatedThreadStaticBindingWarningE().Format)
+ | DeprecatedThreadStaticBindingWarning _ -> os.Append(DeprecatedThreadStaticBindingWarningE().Format)
| FunctionValueUnexpected(denv, ty, _) ->
let ty, _cxs = PrettyTypes.PrettifyType denv.g ty
- let errorText = FunctionValueUnexpectedE().Format(NicePrint.stringOfTy denv ty)
- os.AppendString errorText
+ os.Append(FunctionValueUnexpectedE(), NicePrint.richTextOfTy denv ty)
| UnitTypeExpected(denv, ty, _) ->
let ty, _cxs = PrettyTypes.PrettifyType denv.g ty
- let warningText = UnitTypeExpectedE().Format(NicePrint.stringOfTy denv ty)
- os.AppendString warningText
+ os.Append(UnitTypeExpectedE(), NicePrint.richTextOfTy denv ty)
| UnitTypeExpectedWithEquality(denv, ty, _) ->
let ty, _cxs = PrettyTypes.PrettifyType denv.g ty
-
- let warningText =
- UnitTypeExpectedWithEqualityE().Format(NicePrint.stringOfTy denv ty)
-
- os.AppendString warningText
+ os.Append(UnitTypeExpectedWithEqualityE(), NicePrint.richTextOfTy denv ty)
| UnitTypeExpectedWithPossiblePropertySetter(denv, ty, bindingName, propertyName, _) ->
let ty, _cxs = PrettyTypes.PrettifyType denv.g ty
+ let ty = NicePrint.richTextOfTy denv ty
- let warningText =
- UnitTypeExpectedWithPossiblePropertySetterE().Format (NicePrint.stringOfTy denv ty) bindingName propertyName
-
- os.AppendString warningText
+ os.Append(UnitTypeExpectedWithPossiblePropertySetterE(), ty, RichText.mkLocal bindingName, RichText.mkProperty propertyName)
| UnitTypeExpectedWithPossibleAssignment(denv, ty, isAlreadyMutable, bindingName, _) ->
let ty, _cxs = PrettyTypes.PrettifyType denv.g ty
+ let ty = NicePrint.richTextOfTy denv ty
- let warningText =
- if isAlreadyMutable then
- UnitTypeExpectedWithPossibleAssignmentToMutableE().Format (NicePrint.stringOfTy denv ty) bindingName
- else
- UnitTypeExpectedWithPossibleAssignmentE().Format (NicePrint.stringOfTy denv ty) bindingName
+ let bindingName = RichText.mkLocal bindingName
- os.AppendString warningText
+ if isAlreadyMutable then
+ os.Append(UnitTypeExpectedWithPossibleAssignmentToMutableE(), ty, bindingName)
+ else
+ os.Append(UnitTypeExpectedWithPossibleAssignmentE(), ty, bindingName)
- | RecursiveUseCheckedAtRuntime _ -> os.AppendString(RecursiveUseCheckedAtRuntimeE().Format)
+ | RecursiveUseCheckedAtRuntime _ -> os.Append(RecursiveUseCheckedAtRuntimeE().Format)
- | LetRecUnsound(_, [ v ], _) -> os.AppendString(LetRecUnsound1E().Format v.DisplayName)
+ | LetRecUnsound(denv, [ v ], _) -> os.Append(LetRecUnsound1E(), richTextOfValName denv.g v.Deref)
- | LetRecUnsound(_, path, _) ->
- let bos = StringBuilder()
+ | LetRecUnsound(denv, path, _) ->
+ let bos = RichTextBuilder()
(path.Tail @ [ path.Head ])
- |> List.iter (fun (v: ValRef) -> bos.AppendString(LetRecUnsoundInnerE().Format v.DisplayName))
+ |> List.iter (fun (v: ValRef) -> bos.Append(LetRecUnsoundInnerE(), richTextOfValName denv.g v.Deref))
- os.AppendString(LetRecUnsound2E().Format (List.head path).DisplayName (bos.ToString()))
+ os.Append(LetRecUnsound2E(), richTextOfValName denv.g (List.head path).Deref, bos.ToRichText())
- | LetRecEvaluatedOutOfOrder _ -> os.AppendString(LetRecEvaluatedOutOfOrderE().Format)
+ | LetRecEvaluatedOutOfOrder _ -> os.Append(LetRecEvaluatedOutOfOrderE().Format)
- | LetRecCheckedAtRuntime _ -> os.AppendString(LetRecCheckedAtRuntimeE().Format)
+ | LetRecCheckedAtRuntime _ -> os.Append(LetRecCheckedAtRuntimeE().Format)
- | SelfRefObjCtor(false, _) -> os.AppendString(SelfRefObjCtor1E().Format)
+ | SelfRefObjCtor(false, _) -> os.Append(SelfRefObjCtor1E().Format)
- | SelfRefObjCtor(true, _) -> os.AppendString(SelfRefObjCtor2E().Format)
+ | SelfRefObjCtor(true, _) -> os.Append(SelfRefObjCtor2E().Format)
- | VirtualAugmentationOnNullValuedType _ -> os.AppendString(VirtualAugmentationOnNullValuedTypeE().Format)
+ | VirtualAugmentationOnNullValuedType _ -> os.Append(VirtualAugmentationOnNullValuedTypeE().Format)
- | NonVirtualAugmentationOnNullValuedType _ -> os.AppendString(NonVirtualAugmentationOnNullValuedTypeE().Format)
+ | NonVirtualAugmentationOnNullValuedType _ -> os.Append(NonVirtualAugmentationOnNullValuedTypeE().Format)
| NonUniqueInferredAbstractSlot(_, denv, bindnm, bvirt1, bvirt2, _) ->
- os.AppendString(NonUniqueInferredAbstractSlot1E().Format bindnm)
+ os.Append(NonUniqueInferredAbstractSlot1E(), RichText.mkMember bindnm)
let ty1 = bvirt1.ApparentEnclosingType
let ty2 = bvirt2.ApparentEnclosingType
// REVIEW: consider if we need to show _cxs (the type parameter constraints)
- let ty1, ty2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
- os.AppendString(NonUniqueInferredAbstractSlot2E().Format)
+ let ty1, ty2, _cxs = NicePrint.minimalRichTextsOfTwoTypes denv ty1 ty2
+ os.Append(NonUniqueInferredAbstractSlot2E().Format)
if ty1 <> ty2 then
- os.AppendString(NonUniqueInferredAbstractSlot3E().Format ty1 ty2)
+ os.Append(NonUniqueInferredAbstractSlot3E(), ty1, ty2)
- os.AppendString(NonUniqueInferredAbstractSlot4E().Format)
+ os.Append(NonUniqueInferredAbstractSlot4E().Format)
| DiagnosticWithText(_, s, _)
- | DiagnosticEnabledWithLanguageFeature(_, s, _, _) -> os.AppendString s
+ | DiagnosticEnabledWithLanguageFeature(_, s, _, _) -> os.Append s
| DiagnosticWithSuggestions(_, s, _, idText, suggestionF) ->
- os.AppendString(ConvertValLogicalNameToDisplayNameCore s)
+ os.Append s
OutputNameSuggestions os suggestNames suggestionF idText
| InternalError(s, _)
@@ -1816,52 +1851,52 @@ type Exception with
let f2 = SR.GetString("Failure2")
match s with
- | f when f = f1 -> os.AppendString(Failure3E().Format s)
- | f when f = f2 -> os.AppendString(Failure3E().Format s)
- | _ -> os.AppendString(Failure4E().Format s)
+ | f when f = f1 -> os.Append(Failure3E().Format s)
+ | f when f = f2 -> os.Append(Failure3E().Format s)
+ | _ -> os.Append(Failure4E().Format s)
#if DEBUG
- Printf.bprintf os "\nStack Trace\n%s\n" (exn.ToString())
+ os.Append(sprintf "\nStack Trace\n%s\n" (exn.ToString()))
Debug.Assert(false, sprintf "Unexpected exception seen in compiler: %s\n%s" s (exn.ToString()))
#endif
| WrappedError(e, _) -> e.Output(os, suggestNames)
| PatternMatchCompilation.MatchIncomplete(isComp, cexOpt, _) ->
- os.AppendString(MatchIncomplete1E().Format)
+ os.Append(MatchIncomplete1E().Format)
match cexOpt with
| None -> ()
- | Some(cex, false) -> os.AppendString(MatchIncomplete2E().Format cex)
- | Some(cex, true) -> os.AppendString(MatchIncomplete3E().Format cex)
+ | Some(cex, false) -> os.Append(MatchIncomplete2E(), cex)
+ | Some(cex, true) -> os.Append(MatchIncomplete3E(), cex)
if isComp then
- os.AppendString(MatchIncomplete4E().Format)
+ os.Append(MatchIncomplete4E().Format)
| PatternMatchCompilation.MatchIncompleteForLoopHint(PatternMatchCompilation.MatchIncomplete(isComp, cexOpt, _)) ->
- os.AppendString(MatchIncomplete1E().Format)
+ os.Append(MatchIncomplete1E().Format)
match cexOpt with
| None -> ()
- | Some(cex, false) -> os.AppendString(MatchIncomplete2E().Format cex)
- | Some(cex, true) -> os.AppendString(MatchIncomplete3E().Format cex)
+ | Some(cex, false) -> os.Append(MatchIncomplete2E(), cex)
+ | Some(cex, true) -> os.Append(MatchIncomplete3E(), cex)
- os.AppendString(MatchIncompleteForLoopE().Format)
+ os.Append(MatchIncompleteForLoopE().Format)
if isComp then
- os.AppendString(MatchIncomplete4E().Format)
+ os.Append(MatchIncomplete4E().Format)
| PatternMatchCompilation.EnumMatchIncomplete(isComp, cexOpt, _) ->
- os.AppendString(EnumMatchIncomplete1E().Format)
+ os.Append(EnumMatchIncomplete1E().Format)
match cexOpt with
| None -> ()
- | Some(cex, false) -> os.AppendString(MatchIncomplete2E().Format cex)
- | Some(cex, true) -> os.AppendString(MatchIncomplete3E().Format cex)
+ | Some(cex, false) -> os.Append(MatchIncomplete2E(), cex)
+ | Some(cex, true) -> os.Append(MatchIncomplete3E(), cex)
if isComp then
- os.AppendString(MatchIncomplete4E().Format)
+ os.Append(MatchIncomplete4E().Format)
- | PatternMatchCompilation.RuleNeverMatched _ -> os.AppendString(RuleNeverMatchedE().Format)
+ | PatternMatchCompilation.RuleNeverMatched _ -> os.Append(RuleNeverMatchedE().Format)
| ValNotMutable(_, vref, _) ->
let name = vref.DisplayName
@@ -1872,35 +1907,35 @@ type Exception with
else
ValNotMutableE().Format name
- os.AppendString msg
+ os.Append msg
- | ValNotLocal _ -> os.AppendString(ValNotLocalE().Format)
+ | ValNotLocal _ -> os.Append(ValNotLocalE().Format)
| ObsoleteDiagnostic(message = message) ->
- os.AppendString(Obsolete1E().Format)
+ os.Append(Obsolete1E().Format)
match message with
- | Some message when message <> "" -> os.AppendString(Obsolete2E().Format message)
+ | Some message when not message.IsEmpty -> os.Append(Obsolete2E(), message)
| _ -> ()
| Experimental(message = message) ->
- os.AppendString(Experimental1E().Format)
+ os.Append(Experimental1E().Format)
match message with
- | Some message when message <> "" -> os.AppendString(Experimental2E().Format message)
+ | Some message when message <> "" -> os.Append(Experimental2E().Format message)
| _ -> ()
- os.AppendString(Experimental3E().Format)
+ os.Append(Experimental3E().Format)
- | PossibleUnverifiableCode _ -> os.AppendString(PossibleUnverifiableCodeE().Format)
+ | PossibleUnverifiableCode _ -> os.Append(PossibleUnverifiableCodeE().Format)
- | UserCompilerMessage(msg, _, _) -> os.AppendString msg
+ | UserCompilerMessage(msg, _, _) -> os.Append msg
- | Deprecated(s, _) -> os.AppendString(DeprecatedE().Format s)
+ | Deprecated(s, _) -> os.Append(DeprecatedE(), s)
- | LibraryUseOnly _ -> os.AppendString(LibraryUseOnlyE().Format)
+ | LibraryUseOnly _ -> os.Append(LibraryUseOnlyE().Format)
- | MissingFields(sl, _) -> os.AppendString(MissingFieldsE().Format(String.concat "," sl + "."))
+ | MissingFields(sl, _) -> os.Append(MissingFieldsE().Format(String.concat "," sl + "."))
| ValueRestriction(denv, infoReader, v, _, _) ->
let denv =
@@ -1910,141 +1945,134 @@ type Exception with
let tau = v.TauType
- if isFunTy denv.g tau && (arityOfVal v).HasNoArgs then
- let msg =
- ValueRestrictionFunctionE().Format
- v.DisplayName
- (NicePrint.stringOfQualifiedValOrMember denv infoReader (mkLocalValRef v))
- v.DisplayName
+ let name = richTextOfValName denv.g v
- os.AppendString msg
- else
- let msg =
- ValueRestrictionE().Format
- v.DisplayName
- (NicePrint.stringOfQualifiedValOrMember denv infoReader (mkLocalValRef v))
- v.DisplayName
+ let signature =
+ NicePrint.richTextOfQualifiedValOrMember denv infoReader (mkLocalValRef v)
- os.AppendString msg
+ if isFunTy denv.g tau && (arityOfVal v).HasNoArgs then
+ os.Append(ValueRestrictionFunctionE(), name, signature, name)
+ else
+ os.Append(ValueRestrictionE(), name, signature, name)
- | Parsing.RecoverableParseError -> os.AppendString(RecoverableParseErrorE().Format)
+ | Parsing.RecoverableParseError -> os.Append(RecoverableParseErrorE().Format)
- | ReservedKeyword(s, _) -> os.AppendString(ReservedKeywordE().Format s)
+ | ReservedKeyword(s, _) -> os.Append(ReservedKeywordE(), s)
- | IndentationProblem(s, _) -> os.AppendString(IndentationProblemE().Format s)
+ | IndentationProblem(s, _) -> os.Append(IndentationProblemE().Format s)
- | OverrideInIntrinsicAugmentation _ -> os.AppendString(OverrideInIntrinsicAugmentationE().Format)
+ | OverrideInIntrinsicAugmentation _ -> os.Append(OverrideInIntrinsicAugmentationE().Format)
- | OverrideInExtrinsicAugmentation _ -> os.AppendString(OverrideInExtrinsicAugmentationE().Format)
+ | OverrideInExtrinsicAugmentation _ -> os.Append(OverrideInExtrinsicAugmentationE().Format)
- | IntfImplInIntrinsicAugmentation _ -> os.AppendString(IntfImplInIntrinsicAugmentationE().Format)
+ | IntfImplInIntrinsicAugmentation _ -> os.Append(IntfImplInIntrinsicAugmentationE().Format)
- | IntfImplInExtrinsicAugmentation _ -> os.AppendString(IntfImplInExtrinsicAugmentationE().Format)
+ | IntfImplInExtrinsicAugmentation _ -> os.Append(IntfImplInExtrinsicAugmentationE().Format)
| UnresolvedReferenceError(assemblyName, _)
- | UnresolvedReferenceNoRange assemblyName -> os.AppendString(UnresolvedReferenceNoRangeE().Format assemblyName)
+ | UnresolvedReferenceNoRange assemblyName -> os.Append(UnresolvedReferenceNoRangeE().Format assemblyName)
| UnresolvedPathReference(assemblyName, pathname, _)
| UnresolvedPathReferenceNoRange(assemblyName, pathname) ->
- os.AppendString(UnresolvedPathReferenceNoRangeE().Format pathname assemblyName)
+ os.Append(UnresolvedPathReferenceNoRangeE().Format pathname assemblyName)
- | DeprecatedCommandLineOptionFull(fullText, _) -> os.AppendString fullText
+ | DeprecatedCommandLineOptionFull(fullText, _) -> os.Append fullText
- | DeprecatedCommandLineOptionForHtmlDoc(optionName, _) -> os.AppendString(FSComp.SR.optsDCLOHtmlDoc optionName)
+ | DeprecatedCommandLineOptionForHtmlDoc(optionName, _) -> os.Append(FSComp.SR.optsDCLOHtmlDoc optionName)
| DeprecatedCommandLineOptionSuggestAlternative(optionName, altOption, _) ->
- os.AppendString(FSComp.SR.optsDCLODeprecatedSuggestAlternative (optionName, altOption))
+ os.Append(FSComp.SR.optsDCLODeprecatedSuggestAlternative (optionName, altOption))
- | InternalCommandLineOption(optionName, _) -> os.AppendString(FSComp.SR.optsInternalNoDescription optionName)
+ | InternalCommandLineOption(optionName, _) -> os.Append(FSComp.SR.optsInternalNoDescription optionName)
- | DeprecatedCommandLineOptionNoDescription(optionName, _) -> os.AppendString(FSComp.SR.optsDCLONoDescription optionName)
+ | DeprecatedCommandLineOptionNoDescription(optionName, _) -> os.Append(FSComp.SR.optsDCLONoDescription optionName)
- | HashIncludeNotAllowedInNonScript _ -> os.AppendString(HashIncludeNotAllowedInNonScriptE().Format)
+ | HashIncludeNotAllowedInNonScript _ -> os.Append(HashIncludeNotAllowedInNonScriptE().Format)
- | HashReferenceNotAllowedInNonScript _ -> os.AppendString(HashReferenceNotAllowedInNonScriptE().Format)
+ | HashReferenceNotAllowedInNonScript _ -> os.Append(HashReferenceNotAllowedInNonScriptE().Format)
- | HashDirectiveNotAllowedInNonScript _ -> os.AppendString(HashDirectiveNotAllowedInNonScriptE().Format)
+ | HashDirectiveNotAllowedInNonScript _ -> os.Append(HashDirectiveNotAllowedInNonScriptE().Format)
- | FileNameNotResolved(fileName, locations, _) -> os.AppendString(FileNameNotResolvedE().Format fileName locations)
+ | FileNameNotResolved(fileName, locations, _) -> os.Append(FileNameNotResolvedE().Format fileName locations)
- | AssemblyNotResolved(originalName, _) -> os.AppendString(AssemblyNotResolvedE().Format originalName)
+ | AssemblyNotResolved(originalName, _) -> os.Append(AssemblyNotResolvedE().Format originalName)
| IllegalFileNameChar(fileName, invalidChar) ->
- os.AppendString(FSComp.SR.buildUnexpectedFileNameCharacter (fileName, string invalidChar) |> snd)
+ os.Append(FSComp.SR.buildUnexpectedFileNameCharacter (fileName, string invalidChar) |> snd)
| HashLoadedSourceHasIssues(infos, warnings, errors, _) ->
match warnings, errors with
| _, e :: _ ->
- os.AppendString(HashLoadedSourceHasIssues2E().Format)
+ os.Append(HashLoadedSourceHasIssues2E().Format)
e.Output(os, suggestNames)
| e :: _, _ ->
- os.AppendString(HashLoadedSourceHasIssues1E().Format)
+ os.Append(HashLoadedSourceHasIssues1E().Format)
e.Output(os, suggestNames)
| [], [] ->
- os.AppendString(HashLoadedSourceHasIssues0E().Format)
+ os.Append(HashLoadedSourceHasIssues0E().Format)
infos.Head.Output(os, suggestNames)
- | HashLoadedScriptConsideredSource _ -> os.AppendString(HashLoadedScriptConsideredSourceE().Format)
+ | HashLoadedScriptConsideredSource _ -> os.Append(HashLoadedScriptConsideredSourceE().Format)
| InvalidInternalsVisibleToAssemblyName(badName, fileNameOption) ->
match fileNameOption with
- | Some file -> os.AppendString(InvalidInternalsVisibleToAssemblyName1E().Format badName file)
- | None -> os.AppendString(InvalidInternalsVisibleToAssemblyName2E().Format badName)
+ | Some file -> os.Append(InvalidInternalsVisibleToAssemblyName1E().Format badName file)
+ | None -> os.Append(InvalidInternalsVisibleToAssemblyName2E().Format badName)
- | LoadedSourceNotFoundIgnoring(fileName, _) -> os.AppendString(LoadedSourceNotFoundIgnoringE().Format fileName)
+ | LoadedSourceNotFoundIgnoring(fileName, _) -> os.Append(LoadedSourceNotFoundIgnoringE().Format fileName)
| MSBuildReferenceResolutionWarning(code, message, _)
- | MSBuildReferenceResolutionError(code, message, _) -> os.AppendString(MSBuildReferenceResolutionErrorE().Format message code)
+ | MSBuildReferenceResolutionError(code, message, _) -> os.Append(MSBuildReferenceResolutionErrorE().Format message code)
| ArgumentsInSigAndImplMismatch(sigArg, implArg) ->
- os.AppendString(ArgumentsInSigAndImplMismatchE().Format sigArg.idText implArg.idText)
+ os.Append(ArgumentsInSigAndImplMismatchE(), RichText.mkParameter sigArg.idText, RichText.mkParameter implArg.idText)
| DefinitionsInSigAndImplNotCompatibleAbbreviationsDiffer(denv, implTycon, _sigTycon, implTypeAbbrev, sigTypeAbbrev, _m) ->
- let s1, s2, _ = NicePrint.minimalStringsOfTwoTypes denv implTypeAbbrev sigTypeAbbrev
-
- os.AppendString(
- DefinitionsInSigAndImplNotCompatibleAbbreviationsDifferE().Format
- (implTycon.TypeOrMeasureKind.ToString())
- implTycon.DisplayName
- s1
- s2
+ let s1, s2, _ =
+ NicePrint.minimalRichTextsOfTwoTypes denv implTypeAbbrev sigTypeAbbrev
+
+ os.Append(
+ DefinitionsInSigAndImplNotCompatibleAbbreviationsDifferE(),
+ RichText.mkText (implTycon.TypeOrMeasureKind.ToString()),
+ richTextOfEntity implTycon,
+ s1,
+ s2
)
| InvalidAttributeTargetForLanguageElement(elementTargets, allowedTargets, _m) ->
if Array.isEmpty elementTargets then
- os.AppendString(InvalidAttributeTargetForLanguageElement2E().Format)
+ os.Append(InvalidAttributeTargetForLanguageElement2E().Format)
else
let elementTargets = String.concat ", " elementTargets
let allowedTargets = allowedTargets |> String.concat ", "
- os.AppendString(InvalidAttributeTargetForLanguageElement1E().Format elementTargets allowedTargets)
+ os.Append(InvalidAttributeTargetForLanguageElement1E().Format elementTargets allowedTargets)
- | NoConstructorsAvailableForType(t, denv, _) ->
- os.AppendString(NoConstructorsAvailableForTypeE().Format(NicePrint.minimalStringOfType denv t))
+ | NoConstructorsAvailableForType(t, denv, _) -> os.Append(NoConstructorsAvailableForTypeE(), NicePrint.minimalRichTextOfType denv t)
// Strip TargetInvocationException wrappers
| :? TargetInvocationException as e when isNotNull e.InnerException -> (!!e.InnerException).Output(os, suggestNames)
- | :? FileNotFoundException as exn -> Printf.bprintf os "%s" exn.Message
+ | :? FileNotFoundException as exn -> os.Append exn.Message
- | :? DirectoryNotFoundException as exn -> Printf.bprintf os "%s" exn.Message
+ | :? DirectoryNotFoundException as exn -> os.Append exn.Message
- | :? ArgumentException as exn -> Printf.bprintf os "%s" exn.Message
+ | :? ArgumentException as exn -> os.Append exn.Message
- | :? NotSupportedException as exn -> Printf.bprintf os "%s" exn.Message
+ | :? NotSupportedException as exn -> os.Append exn.Message
- | :? IOException as exn -> Printf.bprintf os "%s" exn.Message
+ | :? IOException as exn -> os.Append exn.Message
- | :? UnauthorizedAccessException as exn -> Printf.bprintf os "%s" exn.Message
+ | :? UnauthorizedAccessException as exn -> os.Append exn.Message
- | :? InvalidOperationException as exn when exn.Message.Contains "ControlledExecution.Run" -> Printf.bprintf os "%s" exn.Message
+ | :? InvalidOperationException as exn when exn.Message.Contains "ControlledExecution.Run" -> os.Append exn.Message
| exn ->
- os.AppendString(TargetInvocationExceptionWrapperE().Format exn.Message)
+ os.Append(TargetInvocationExceptionWrapperE().Format exn.Message)
#if DEBUG
- Printf.bprintf os "\nStack Trace\n%s\n" (exn.ToString())
+ os.Append(sprintf "\nStack Trace\n%s\n" (exn.ToString()))
if showAssertForUnexpectedException.Value then
Debug.Assert(false, sprintf "Unknown exception seen in compiler: %s" (exn.ToString()))
@@ -2054,30 +2082,21 @@ type Exception with
type PhasedDiagnostic with
// remove any newlines and tabs
- member x.OutputCore(os: StringBuilder, flattenErrors: bool, suggestNames: bool) =
- let buf = StringBuilder()
+ member x.FormatRichCore(flattenErrors: bool, suggestNames: bool) =
+ let buf = RichTextBuilder()
x.Exception.Output(buf, suggestNames)
- let text =
- if flattenErrors then
- NormalizeErrorString(buf.ToString())
- else
- buf.ToString()
+ let text = buf.ToRichText()
- os.AppendString text
+ if flattenErrors then NormalizeErrorRichText text else text
- member x.FormatCore(flattenErrors: bool, suggestNames: bool) =
- let os = StringBuilder()
- x.OutputCore(os, flattenErrors, suggestNames)
- os.ToString()
+ member x.FormatCore(flattenErrors: bool, suggestNames: bool) = x.FormatRichCore(flattenErrors, suggestNames).Text
member x.EagerlyFormatCore(suggestNames: bool) =
match x.Range with
| Some m ->
- let buf = StringBuilder()
- x.Exception.Output(buf, suggestNames)
- let message = buf.ToString()
+ let message = x.FormatRichCore(false, suggestNames)
let exn = DiagnosticWithText(x.Number, message, m)
{ x with Exception = exn }
| None -> x
diff --git a/src/Compiler/Driver/CompilerDiagnostics.fsi b/src/Compiler/Driver/CompilerDiagnostics.fsi
index 0cf57b81e8c..30ef273f143 100644
--- a/src/Compiler/Driver/CompilerDiagnostics.fsi
+++ b/src/Compiler/Driver/CompilerDiagnostics.fsi
@@ -57,6 +57,9 @@ type PhasedDiagnostic with
/// Eagerly format a PhasedDiagnostic return as a new PhasedDiagnostic requiring no formatting of types.
member EagerlyFormatCore: suggestNames: bool -> PhasedDiagnostic
+ /// Format the core of the diagnostic as rich text. Doesn't include the range information.
+ member FormatRichCore: flattenErrors: bool * suggestNames: bool -> RichText
+
/// Format the core of the diagnostic as a string. Doesn't include the range information.
member FormatCore: flattenErrors: bool * suggestNames: bool -> string
diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs
index f0868919ad0..c66b8ad1d3f 100644
--- a/src/Compiler/Driver/CompilerImports.fs
+++ b/src/Compiler/Driver/CompilerImports.fs
@@ -1958,7 +1958,16 @@ and [] TcImports
match providers with
| [] ->
let typeName = !!typeof.FullName
- warning (Error(FSComp.SR.etHostingAssemblyFoundWithoutHosts (fileNameOfRuntimeAssembly, typeName), m))
+
+ warning (
+ RichError(
+ FSComp.SR.etHostingAssemblyFoundWithoutHosts (
+ RichText.mkText fileNameOfRuntimeAssembly,
+ RichText.mkQualifiedTypeName typeName
+ ),
+ m
+ )
+ )
| _ ->
#if DEBUG
diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs
index 92e72d6b89b..21ac73010ad 100644
--- a/src/Compiler/Driver/ParseAndCheckInputs.fs
+++ b/src/Compiler/Driver/ParseAndCheckInputs.fs
@@ -105,7 +105,15 @@ let ComputeAnonModuleName check defaultNamespace fileName (m: range) =
let modname = CanonicalizeFilename fileName
if check && not (IsValidAnonModuleName modname) && not (IsScript fileName) then
- warning (Error(FSComp.SR.buildImplicitModuleIsNotLegalIdentifier (modname, (FileSystemUtils.fileNameOfPath fileName)), m))
+ warning (
+ RichError(
+ FSComp.SR.buildImplicitModuleIsNotLegalIdentifier (
+ RichText.mkModule modname,
+ RichText.mkText (FileSystemUtils.fileNameOfPath fileName)
+ ),
+ m
+ )
+ )
let combined =
match defaultNamespace with
@@ -827,7 +835,7 @@ let ProcessMetaCommandsFromInput
errorR (HashDirectiveNotAllowedInNonScript m)
else
let arg = (parsedHashDirectiveArguments [] tcConfig.langVersion)
- warning (Error((FSComp.SR.fsiInvalidDirective (c, String.concat " " arg)), m))
+ warning (RichError((FSComp.SR.fsiInvalidDirective (RichText.mkKeyword c, RichText.mkText (String.concat " " arg))), m))
state
@@ -1174,7 +1182,7 @@ let SkippedImplFilePlaceholder (tcConfig: TcConfig, tcImports: TcImports, tcGlob
// Check if we've already seen an implementation for this fragment
if Zset.contains qualNameOfFile tcState.tcsRootImpls then
- errorR (Error(FSComp.SR.buildImplementationAlreadyGiven qualNameOfFile.Text, input.Range))
+ errorR (RichError(FSComp.SR.buildImplementationAlreadyGiven (RichText.mkModule qualNameOfFile.Text), input.Range))
let hadSig = rootSigOpt.IsSome
@@ -1234,11 +1242,11 @@ let CheckOneInput
// Check if we've seen this top module signature before.
if Zmap.mem qualNameOfFile tcState.tcsRootSigs then
- errorR (Error(FSComp.SR.buildSignatureAlreadySpecified qualNameOfFile.Text, m.StartRange))
+ errorR (RichError(FSComp.SR.buildSignatureAlreadySpecified (RichText.mkModule qualNameOfFile.Text), m.StartRange))
// Check if the implementation came first in compilation order
if Zset.contains qualNameOfFile tcState.tcsRootImpls then
- errorR (Error(FSComp.SR.buildImplementationAlreadyGivenDetail qualNameOfFile.Text, m))
+ errorR (RichError(FSComp.SR.buildImplementationAlreadyGivenDetail (RichText.mkModule qualNameOfFile.Text), m))
// Typecheck the signature file
let! tcEnv, sigFileType, createsGeneratedProvidedTypes =
@@ -1285,7 +1293,7 @@ let CheckOneInput
// Check if we've already seen an implementation for this fragment
if Zset.contains qualNameOfFile tcState.tcsRootImpls then
- errorR (Error(FSComp.SR.buildImplementationAlreadyGiven qualNameOfFile.Text, m))
+ errorR (RichError(FSComp.SR.buildImplementationAlreadyGiven (RichText.mkModule qualNameOfFile.Text), m))
let hadSig = rootSigOpt.IsSome
@@ -1372,7 +1380,7 @@ let CheckClosedInputSetFinish (declaredImpls: CheckedImplFile list, tcState) =
tcState.tcsRootSigs
|> Zmap.iter (fun qualNameOfFile _ ->
if not (Zset.contains qualNameOfFile tcState.tcsRootImpls) then
- errorR (Error(FSComp.SR.buildSignatureWithoutImplementation qualNameOfFile.Text, qualNameOfFile.Range)))
+ errorR (RichError(FSComp.SR.buildSignatureWithoutImplementation (RichText.mkModule qualNameOfFile.Text), qualNameOfFile.Range)))
tcState, declaredImpls, ccuContents
@@ -1451,11 +1459,11 @@ let CheckOneInputWithCallback
// Check if we've seen this top module signature before.
if Zmap.mem qualNameOfFile tcState.tcsRootSigs then
- errorR (Error(FSComp.SR.buildSignatureAlreadySpecified qualNameOfFile.Text, m.StartRange))
+ errorR (RichError(FSComp.SR.buildSignatureAlreadySpecified (RichText.mkModule qualNameOfFile.Text), m.StartRange))
// Check if the implementation came first in compilation order
if Zset.contains qualNameOfFile tcState.tcsRootImpls then
- errorR (Error(FSComp.SR.buildImplementationAlreadyGivenDetail qualNameOfFile.Text, m))
+ errorR (RichError(FSComp.SR.buildImplementationAlreadyGivenDetail (RichText.mkModule qualNameOfFile.Text), m))
// Typecheck the signature file
let! tcEnv, sigFileType, createsGeneratedProvidedTypes =
@@ -1533,7 +1541,7 @@ let CheckOneInputWithCallback
(fun tcState ->
// Check if we've already seen an implementation for this fragment
if Zset.contains qualNameOfFile tcState.tcsRootImpls then
- errorR (Error(FSComp.SR.buildImplementationAlreadyGiven qualNameOfFile.Text, m))
+ errorR (RichError(FSComp.SR.buildImplementationAlreadyGiven (RichText.mkModule qualNameOfFile.Text), m))
let ccuSigForFile, fsTcState =
AddCheckResultsToTcState
diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs
index f5aa287b6a7..4be8663ccb1 100644
--- a/src/Compiler/Driver/fsc.fs
+++ b/src/Compiler/Driver/fsc.fs
@@ -393,7 +393,12 @@ let TryFindVersionAttribute g attrib attribName attribs deterministic =
match AttributeHelpers.TryFindStringAttribute g attrib attribs with
| Some versionString ->
if deterministic && versionString.Contains("*") then
- errorR (Error(FSComp.SR.fscAssemblyWildcardAndDeterminism (attribName, versionString), rangeStartup))
+ errorR (
+ RichError(
+ FSComp.SR.fscAssemblyWildcardAndDeterminism (RichText.mkClass attribName, RichText.mkText versionString),
+ rangeStartup
+ )
+ )
try
Some(parseILVersion versionString)
diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj
index 1f5278f6ecc..907c74cc7ce 100644
--- a/src/Compiler/FSharp.Compiler.Service.fsproj
+++ b/src/Compiler/FSharp.Compiler.Service.fsproj
@@ -102,9 +102,9 @@
-
FSComp.txt
+ true
FSIstrings.txt
@@ -113,16 +113,19 @@
FSStrings.resx
FSStrings.resources
+
+
+
+
+
+
+
-
-
-
-
diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs
index 2f2a1a70159..101db68b2e7 100644
--- a/src/Compiler/Facilities/DiagnosticsLogger.fs
+++ b/src/Compiler/Facilities/DiagnosticsLogger.fs
@@ -78,10 +78,10 @@ let (|StopProcessing|_|) exn =
let StopProcessing<'T> = StopProcessingExn None
// int is e.g. 191 in FS0191
-exception DiagnosticWithText of number: int * message: string * range: range with
+exception DiagnosticWithText of number: int * message: RichText * range: range with
override this.Message =
match this :> exn with
- | DiagnosticWithText(_, msg, _) -> msg
+ | DiagnosticWithText(_, msg, _) -> msg.Text
| _ -> "impossible"
exception InternalError of message: string * range: range with
@@ -101,11 +101,11 @@ exception InternalException of exn: Exception * msg: string * range: range with
| InternalException(exn, _, _) -> exn.ToString()
| _ -> "impossible"
-exception UserCompilerMessage of message: string * number: int * range: range
+exception UserCompilerMessage of message: RichText * number: int * range: range
exception LibraryUseOnly of range: range
-exception Deprecated of message: string * range: range
+exception Deprecated of message: RichText * range: range
exception Experimental of message: string option * diagnosticId: string option * urlFormat: string option * range: range
@@ -123,14 +123,14 @@ exception UnresolvedPathReferenceNoRange of assemblyName: string * path: string
exception UnresolvedPathReference of assemblyName: string * path: string * range: range
-exception DiagnosticWithSuggestions of number: int * message: string * range: range * identifier: string * suggestions: Suggestions with // int is e.g. 191 in FS0191
+exception DiagnosticWithSuggestions of number: int * message: RichText * range: range * identifier: string * suggestions: Suggestions with // int is e.g. 191 in FS0191
override this.Message =
match this :> exn with
- | DiagnosticWithSuggestions(_, msg, _, _, _) -> msg
+ | DiagnosticWithSuggestions(_, msg, _, _, _) -> msg.Text
| _ -> "impossible"
/// A diagnostic that is raised when enabled manually, or by default with a language feature
-exception DiagnosticEnabledWithLanguageFeature of number: int * message: string * range: range * enabledByLangFeature: bool
+exception DiagnosticEnabledWithLanguageFeature of number: int * message: RichText * range: range * enabledByLangFeature: bool
type ObsoleteDiagnosticInfo =
| ObsoleteDiagnosticInfo of isError: bool * diagnosticId: string option * message: string option * urlFormat: string option
@@ -138,7 +138,7 @@ type ObsoleteDiagnosticInfo =
exception ObsoleteDiagnostic of
isError: bool *
diagnosticId: string option *
- message: string option *
+ message: RichText option *
urlFormat: string option *
range: range
@@ -146,7 +146,12 @@ exception ObsoleteDiagnostic of
/// an DiagnosticWithText as an exception even if it's a warning.
///
/// We will eventually rename this to remove this use of "Error"
-let Error ((n, text), m) = DiagnosticWithText(n, text, m)
+let Error ((n, text), m) =
+ DiagnosticWithText(n, RichText.mkText text, m)
+
+/// Same as 'Error(...)', but for a message whose parts are classified, so that tooling is able to
+/// render it with colors. See docs/rich-diagnostics.md.
+let RichError ((n, text): int * RichText, m) = DiagnosticWithText(n, text, m)
/// The F# compiler code currently uses 'ErrorWithSuggestions(...)' in many places to create
/// an DiagnosticWithText as an exception even if it's a warning.
@@ -605,14 +610,14 @@ let stopProcessingRecovery exn m =
let errorRecoveryNoRange exn =
DiagnosticsThreadStatics.DiagnosticsLogger.ErrorRecoveryNoRange exn
-let deprecatedWithError s m = errorR (Deprecated(s, m))
+let deprecatedWithError (s: RichText) m = errorR (Deprecated(s, m))
let libraryOnlyError m = errorR (LibraryUseOnly m)
let libraryOnlyWarning m = warning (LibraryUseOnly m)
let deprecatedOperator m =
- deprecatedWithError (FSComp.SR.elDeprecatedOperator ()) m
+ deprecatedWithError (RichText.mkText (FSComp.SR.elDeprecatedOperator ())) m
[]
let suppressErrorReporting f =
@@ -826,6 +831,51 @@ let NormalizeErrorString (text: string) =
buf.ToString()
+/// Same as 'NormalizeErrorString', but applied to the parts of a rich message, so that the
+/// classification of each part is preserved. Parts left empty by normalization are dropped.
+let NormalizeErrorRichText (text: RichText) =
+ let full = text.Text
+
+ // 'NormalizeErrorString' trims the message as a whole, so the trimmed range is computed over all
+ // parts rather than over each part on its own.
+ let mutable startIndex = 0
+ let mutable endIndex = full.Length
+
+ while startIndex < endIndex && Char.IsWhiteSpace full[startIndex] do
+ startIndex <- startIndex + 1
+
+ while endIndex > startIndex && Char.IsWhiteSpace full[endIndex - 1] do
+ endIndex <- endIndex - 1
+
+ let parts = ResizeArray()
+ let buf = System.Text.StringBuilder()
+ let mutable index = 0
+ // Set once a '\r' was replaced, so that a '\n' completing the sequence produces no second proxy,
+ // even when it belongs to the next part
+ let mutable skipLineFeed = false
+
+ for part in text.Parts do
+ buf.Clear() |> ignore
+
+ for c in part.Text do
+ if index >= startIndex && index < endIndex then
+ match c with
+ | '\n' when skipLineFeed -> ()
+ | '\r'
+ | '\n' -> buf.Append stringThatIsAProxyForANewlineInFlatErrors |> ignore
+ | c ->
+ // handle remaining chars: control - replace with space, others - keep unchanged
+ buf.Append(if Char.IsControl c then ' ' else c) |> ignore
+
+ skipLineFeed <- c = '\r'
+
+ index <- index + 1
+
+ if buf.Length > 0 then
+ parts.Add(TaggedText(part.Tag, buf.ToString()))
+
+ RichText.ofParts (parts.ToArray())
+
/// Indicates whether a language feature check should be skipped. Typically used in recursive functions
/// where we don't want repeated recursive calls to raise the same diagnostic multiple times.
[]
diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi
index a6e787e8c8b..c867687582d 100644
--- a/src/Compiler/Facilities/DiagnosticsLogger.fsi
+++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi
@@ -46,27 +46,31 @@ val (|StopProcessing|_|): exn: exn -> unit voption
val StopProcessing<'T> : exn
/// Represents a diagnostic exception whose text comes via SR.*
-exception DiagnosticWithText of number: int * message: string * range: range
+exception DiagnosticWithText of number: int * message: RichText * range: range
/// A diagnostic that is raised when enabled manually, or by default with a language feature
exception DiagnosticEnabledWithLanguageFeature of
number: int *
- message: string *
+ message: RichText *
range: range *
enabledByLangFeature: bool
/// Creates a diagnostic exception whose text comes via SR.*
val Error: (int * string) * range -> exn
+/// Same as 'Error', but for a message whose parts are classified, so that tooling is able to render it
+/// with colors. See docs/rich-diagnostics.md.
+val RichError: (int * RichText) * range -> exn
+
exception InternalError of message: string * range: range
exception InternalException of exn: Exception * msg: string * range: range
-exception UserCompilerMessage of message: string * number: int * range: range
+exception UserCompilerMessage of message: RichText * number: int * range: range
exception LibraryUseOnly of range: range
-exception Deprecated of message: string * range: range
+exception Deprecated of message: RichText * range: range
exception Experimental of message: string option * diagnosticId: string option * urlFormat: string option * range: range
@@ -82,7 +86,7 @@ exception UnresolvedPathReference of assemblyName: string * path: string * range
exception DiagnosticWithSuggestions of
number: int *
- message: string *
+ message: RichText *
range: range *
identifier: string *
suggestions: Suggestions
@@ -97,15 +101,15 @@ type ObsoleteDiagnosticInfo =
exception ObsoleteDiagnostic of
isError: bool *
diagnosticId: string option *
- message: string option *
+ message: RichText option *
urlFormat: string option *
range: range
/// Creates a DiagnosticWithSuggestions whose text comes via SR.*
-val ErrorWithSuggestions: (int * string) * range * string * Suggestions -> exn
+val ErrorWithSuggestions: (int * RichText) * range * string * Suggestions -> exn
/// Creates a DiagnosticEnabledWithLanguageFeature whose text comes via SR.*
-val ErrorEnabledWithLanguageFeature: (int * string) * range * bool -> exn
+val ErrorEnabledWithLanguageFeature: (int * RichText) * range * bool -> exn
val inline protectAssemblyExploration: dflt: 'T -> f: (unit -> 'T) -> 'T
@@ -330,7 +334,7 @@ val stopProcessingRecovery: exn: exn -> m: range -> unit
val errorRecoveryNoRange: exn: exn -> unit
-val deprecatedWithError: s: string -> m: range -> unit
+val deprecatedWithError: s: RichText -> m: range -> unit
val libraryOnlyError: m: range -> unit
@@ -441,6 +445,10 @@ val NewlineifyErrorString: message: string -> string
/// which is decoded by the IDE with 'NewlineifyErrorString' back into newlines, so that multi-line errors can be displayed in QuickInfo
val NormalizeErrorString: text: string -> string
+/// Same as 'NormalizeErrorString', but applied to the parts of a rich message, so that the
+/// classification of each part is preserved. Parts left empty by normalization are dropped.
+val NormalizeErrorRichText: text: RichText -> RichText
+
/// Indicates whether a language feature check should be skipped. Typically used in recursive functions
/// where we don't want repeated recursive calls to raise the same diagnostic multiple times.
[]
diff --git a/src/Compiler/Facilities/RichText.fs b/src/Compiler/Facilities/RichText.fs
new file mode 100644
index 00000000000..5dd144e7bbb
--- /dev/null
+++ b/src/Compiler/Facilities/RichText.fs
@@ -0,0 +1,281 @@
+// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
+
+namespace FSharp.Compiler.Text
+
+open System
+open System.Text
+open FSharp.Compiler.DiagnosticMessage
+open FSharp.Compiler.Text
+
+[]
+type RichText(parts: TaggedText[]) =
+
+ let text =
+ match parts with
+ | [||] -> ""
+ | [| part |] -> part.Text
+ | parts ->
+ let buf = StringBuilder()
+
+ for part in parts do
+ buf.Append(part.Text) |> ignore
+
+ buf.ToString()
+
+ member _.Parts = parts
+
+ member _.Text = text
+
+ member _.IsEmpty = Array.isEmpty parts
+
+ override _.ToString() = text
+
+ override _.Equals(other) =
+ match other with
+ | :? RichText as other -> text = other.Text
+ | _ -> false
+
+ override _.GetHashCode() = text.GetHashCode()
+
+module RichText =
+
+ let empty = RichText([||])
+
+ let ofParts (parts: TaggedText[]) =
+ if Array.isEmpty parts then empty else RichText(parts)
+
+ let ofTaggedText (part: TaggedText) = RichText([| part |])
+
+ let ofTag tag (text: string) =
+ if String.IsNullOrEmpty text then
+ empty
+ else
+ ofTaggedText (TaggedText.mkTag tag text)
+
+ let mkText text = ofTag TextTag.Text text
+ let mkActivePatternCase text = ofTag TextTag.ActivePatternCase text
+ let mkActivePatternResult text = ofTag TextTag.ActivePatternResult text
+ let mkAlias text = ofTag TextTag.Alias text
+ let mkClass text = ofTag TextTag.Class text
+ let mkDelegate text = ofTag TextTag.Delegate text
+ let mkEnum text = ofTag TextTag.Enum text
+ let mkEvent text = ofTag TextTag.Event text
+ let mkField text = ofTag TextTag.Field text
+ let mkFunction text = ofTag TextTag.Function text
+ let mkInterface text = ofTag TextTag.Interface text
+ let mkKeyword text = ofTag TextTag.Keyword text
+ let mkLineBreak text = ofTag TextTag.LineBreak text
+ let mkLocal text = ofTag TextTag.Local text
+ let mkMember text = ofTag TextTag.Member text
+ let mkMethod text = ofTag TextTag.Method text
+ let mkModule text = ofTag TextTag.Module text
+ let mkModuleBinding text = ofTag TextTag.ModuleBinding text
+ let mkNamespace text = ofTag TextTag.Namespace text
+ let mkNumericLiteral text = ofTag TextTag.NumericLiteral text
+ let mkOperator text = ofTag TextTag.Operator text
+ let mkParameter text = ofTag TextTag.Parameter text
+ let mkProperty text = ofTag TextTag.Property text
+ let mkPunctuation text = ofTag TextTag.Punctuation text
+ let mkRecord text = ofTag TextTag.Record text
+ let mkRecordField text = ofTag TextTag.RecordField text
+ let mkSpace text = ofTag TextTag.Space text
+ let mkStringLiteral text = ofTag TextTag.StringLiteral text
+ let mkStruct text = ofTag TextTag.Struct text
+ let mkTypeParameter text = ofTag TextTag.TypeParameter text
+ let mkUnion text = ofTag TextTag.Union text
+ let mkUnionCase text = ofTag TextTag.UnionCase text
+ let mkUnknownEntity text = ofTag TextTag.UnknownEntity text
+ let mkUnknownType text = ofTag TextTag.UnknownType text
+ let mkUnresolvedName text = ofTag TextTag.UnresolvedName text
+
+ let append (left: RichText) (right: RichText) =
+ if left.IsEmpty then right
+ elif right.IsEmpty then left
+ else RichText(Array.append left.Parts right.Parts)
+
+ let concat (texts: RichText seq) =
+ let parts = ResizeArray()
+
+ for text in texts do
+ parts.AddRange(text.Parts)
+
+ ofParts (parts.ToArray())
+
+ let concatWith (separator: RichText) (texts: RichText seq) =
+ let parts = ResizeArray()
+ let mutable needsSeparator = false
+
+ for text in texts do
+ if needsSeparator then
+ parts.AddRange separator.Parts
+
+ needsSeparator <- true
+ parts.AddRange text.Parts
+
+ ofParts (parts.ToArray())
+
+ let collectParts mapping (text: RichText) =
+ ofParts (Array.collect mapping text.Parts)
+
+ /// A dotted type name, classifying what is before the last dot as a namespace, the dot as
+ /// punctuation, and the name itself as a type of unknown kind. This is for names that arrive from
+ /// metadata, reflection or a type provider as one string; do not use it on an assembly-qualified
+ /// name, since an assembly version has dots in it too.
+ let mkQualifiedName leafOfName (name: string) =
+ match name.LastIndexOf '.' with
+ | -1 -> leafOfName name
+ | i ->
+ let path = name.Substring(0, i)
+ let leaf = name.Substring(i + 1)
+
+ let namespaceParts =
+ path.Split '.'
+ |> Array.map (ofTag TextTag.Namespace)
+ |> concatWith (ofTag TextTag.Punctuation ".")
+
+ concat [ namespaceParts; ofTag TextTag.Punctuation "."; leafOfName leaf ]
+
+ let mkQualifiedTypeName name = mkQualifiedName mkUnknownType name
+
+module RichMessage =
+
+ /// Characters that can stand in for a classified argument while the message is formatted. Control
+ /// characters, so that in practice the first one is always free.
+ let private candidateMarkers =
+ [|
+ for c in '\u0001' .. '\u001f' do
+ if c <> '\n' && c <> '\r' && c <> '\t' then
+ c
+ |]
+
+ /// Replaces the markers in a formatted message with the parts they stand for
+ let private splice (marker: char) (args: ResizeArray) (text: string) =
+ let parts = ResizeArray()
+ let buf = StringBuilder()
+ let mutable i = 0
+
+ let addPendingText () =
+ if buf.Length > 0 then
+ parts.Add(TaggedText.tagText (buf.ToString()))
+ buf.Clear() |> ignore
+
+ while i < text.Length do
+ // A marker is the character followed by the argument index and the character again
+ let mutable index = 0
+ let mutable j = i + 1
+
+ if text[i] = marker then
+ while j < text.Length && text[j] >= '0' && text[j] <= '9' do
+ index <- index * 10 + int text[j] - int '0'
+ j <- j + 1
+
+ if
+ text[i] = marker
+ && j > i + 1
+ && j < text.Length
+ && text[j] = marker
+ && index < args.Count
+ then
+ addPendingText ()
+ parts.AddRange(args[index].Parts)
+ i <- j + 1
+ else
+ buf.Append(text[i]) |> ignore
+ i <- i + 1
+
+ addPendingText ()
+ RichText.ofParts (parts.ToArray())
+
+ /// A resource accessor returns an already-formatted message, so the holes can no longer be told
+ /// apart afterwards. The message is therefore formatted twice: once with the argument texts, which
+ /// is what it has to read as, and once with a marker per classified argument, which the parts are
+ /// then spliced back into. Splicing the formatted message rather than the template is what makes
+ /// this survive a translation reordering, repeating or dropping holes.
+ ///
+ /// The marker is picked absent from the first result, so no argument and no translation can contain
+ /// one. Should the two disagree anyway, the text is what the reader sees, so it wins and the
+ /// classification is dropped.
+ let private formatWithMarkers (format: (RichText -> string) -> 'T) (getText: 'T -> string) =
+ let plain = format (fun arg -> arg.Text)
+ let plainText = getText plain
+
+ let marker = candidateMarkers |> Array.tryFind (fun c -> plainText.IndexOf c < 0)
+
+ match marker with
+ | None -> plain, RichText.mkText plainText
+ | Some marker ->
+ let args = ResizeArray()
+
+ let addArg (arg: RichText) =
+ let index = args.Count
+ args.Add arg
+ String.Concat(string marker, string index, string marker)
+
+ let spliced = splice marker args (getText (format addArg))
+
+ if spliced.Text = plainText then
+ plain, spliced
+ else
+ plain, RichText.mkText plainText
+
+ let text (format: (RichText -> string) -> string) = formatWithMarkers format id |> snd
+
+ let numbered (format: (RichText -> string) -> int * string) =
+ let (number, _), text = formatWithMarkers format snd
+ number, text
+
+[]
+type RichTextBuilder() =
+ let parts = ResizeArray()
+
+ // NavigableTaggedText and other subclasses carry data that merging would lose
+ let isPlain (part: TaggedText) = part.GetType() = typeof
+
+ /// A message is built from many pieces, and where one piece ends tells a consumer nothing unless
+ /// the classification changes there
+ let mergeAdjacentParts () =
+ let merged = ResizeArray(parts.Count)
+
+ for part in parts do
+ if
+ merged.Count > 0
+ && merged[merged.Count - 1].Tag = part.Tag
+ && isPlain merged[merged.Count - 1]
+ && isPlain part
+ then
+ merged[merged.Count - 1] <- TaggedText(part.Tag, merged[merged.Count - 1].Text + part.Text)
+ else
+ merged.Add part
+
+ merged.ToArray()
+
+ member _.Append(value: string) =
+ if not (String.IsNullOrEmpty value) then
+ parts.Add(TaggedText.tagText value)
+
+ member _.Append(value: TaggedText) = parts.Add value
+
+ member _.Append(value: RichText) = parts.AddRange value.Parts
+
+ member this.Append(message: ResourceString string>, a0: RichText) =
+ this.Append(fun rich -> message.Format(rich a0))
+
+ member this.Append(message: ResourceString string -> string>, a0: RichText, a1: RichText) =
+ this.Append(fun rich -> message.Format (rich a0) (rich a1))
+
+ member this.Append(message: ResourceString string -> string -> string>, a0: RichText, a1: RichText, a2: RichText) =
+ this.Append(fun rich -> message.Format (rich a0) (rich a1) (rich a2))
+
+ member this.Append
+ (message: ResourceString string -> string -> string -> string>, a0: RichText, a1: RichText, a2: RichText, a3: RichText)
+ =
+ this.Append(fun rich -> message.Format (rich a0) (rich a1) (rich a2) (rich a3))
+
+ member this.Append(format: (RichText -> string) -> string) = this.Append(RichMessage.text format)
+
+ member _.IsEmpty = parts.Count = 0
+
+ member _.ToRichText() =
+ RichText.ofParts (mergeAdjacentParts ())
+
+ override this.ToString() = this.ToRichText().Text
diff --git a/src/Compiler/Facilities/RichText.fsi b/src/Compiler/Facilities/RichText.fsi
new file mode 100644
index 00000000000..9836036cc7e
--- /dev/null
+++ b/src/Compiler/Facilities/RichText.fsi
@@ -0,0 +1,174 @@
+// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
+
+namespace FSharp.Compiler.Text
+
+open FSharp.Compiler.DiagnosticMessage
+
+/// Represents text made of tagged parts, e.g. a diagnostic message in which types, identifiers and
+/// punctuation are classified, so that tooling is able to render them with colors.
+///
+/// Text that carries no classification is represented as a single part tagged TextTag.Text, so that
+/// a plain string is always representable and Text is always equal to the original string.
+///
+/// Two rich texts are equal when they read the same. Classification does not take part in equality,
+/// since the places that compare texts - such as deciding whether two types can be told apart in a
+/// message - are asking about what reaches the reader.
+[]
+type public RichText =
+
+ /// Gets the tagged parts of the text
+ member Parts: TaggedText[]
+
+ /// Gets the text of all parts concatenated
+ member Text: string
+
+ /// Gets whether the text has no parts
+ member IsEmpty: bool
+
+module public RichText =
+
+ /// Text with no parts
+ val empty: RichText
+
+ /// Creates text from already tagged parts
+ val ofParts: parts: TaggedText[] -> RichText
+
+ /// Creates text from a single tagged part
+ val ofTaggedText: part: TaggedText -> RichText
+
+ /// Creates text from a single part with the given classification. Text that is empty has no parts,
+ /// so that where a part boundary falls is never visible in the result.
+ val ofTag: tag: TextTag -> text: string -> RichText
+
+ /// Creates text from a single part with the classification the name says, for the classifications
+ /// a diagnostic message uses. mkText is unclassified text, i.e. text with nothing in it to classify.
+ /// Prefer computing the classification from what is being named, as richTextOfEntityRefName and
+ /// richTextOfValName do, over choosing one of these by hand.
+ val mkText: text: string -> RichText
+ val mkActivePatternCase: text: string -> RichText
+ val mkActivePatternResult: text: string -> RichText
+ val mkAlias: text: string -> RichText
+ val mkClass: text: string -> RichText
+ val mkDelegate: text: string -> RichText
+ val mkEnum: text: string -> RichText
+ val mkEvent: text: string -> RichText
+ val mkField: text: string -> RichText
+ val mkFunction: text: string -> RichText
+ val mkInterface: text: string -> RichText
+ val mkKeyword: text: string -> RichText
+ val mkLineBreak: text: string -> RichText
+ val mkLocal: text: string -> RichText
+ val mkMember: text: string -> RichText
+ val mkMethod: text: string -> RichText
+ val mkModule: text: string -> RichText
+ val mkModuleBinding: text: string -> RichText
+ val mkNamespace: text: string -> RichText
+ val mkNumericLiteral: text: string -> RichText
+ val mkOperator: text: string -> RichText
+ val mkParameter: text: string -> RichText
+ val mkProperty: text: string -> RichText
+ val mkPunctuation: text: string -> RichText
+ val mkRecord: text: string -> RichText
+ val mkRecordField: text: string -> RichText
+ val mkSpace: text: string -> RichText
+ val mkStringLiteral: text: string -> RichText
+ val mkStruct: text: string -> RichText
+ val mkTypeParameter: text: string -> RichText
+ val mkUnion: text: string -> RichText
+ val mkUnionCase: text: string -> RichText
+ val mkUnknownEntity: text: string -> RichText
+ val mkUnknownType: text: string -> RichText
+ val mkUnresolvedName: text: string -> RichText
+
+ /// Concatenates two texts
+ val append: left: RichText -> right: RichText -> RichText
+
+ /// Concatenates any number of texts
+ val concat: texts: RichText seq -> RichText
+
+ /// Concatenates any number of texts, inserting a separator between them
+ val concatWith: separator: RichText -> texts: RichText seq -> RichText
+
+ /// Replaces every part with zero or more parts, e.g. to split parts containing line breaks
+ val collectParts: mapping: (TaggedText -> TaggedText[]) -> text: RichText -> RichText
+
+ /// A dotted name, classifying the namespace and the dots, and the name itself with the given
+ /// constructor. For names that arrive from metadata, reflection or a type provider as one string;
+ /// not for an assembly-qualified name, since an assembly version has dots in it too.
+ val mkQualifiedName: leafOfName: (string -> RichText) -> name: string -> RichText
+
+ /// A dotted type name whose kind is not known, e.g. because the type could not be dereferenced
+ val mkQualifiedTypeName: name: string -> RichText
+
+/// Splices classified arguments into the holes of a message that comes from a resource file.
+///
+/// A resource accessor returns a message that is already formatted, so the holes can no longer be told
+/// apart afterwards. Instead the message is formatted with a sentinel in place of each classified
+/// argument, and the sentinels are then replaced with the parts they stand for. This way the resource
+/// key stays a compile-checked member reference, and translations are free to reorder, repeat or drop
+/// holes.
+///
+/// This is what the generated FSComp accessors taking classified arguments are built on. Call those
+/// directly where they exist; these take a function instead, for the messages that have no such
+/// overload - the ones from FSStrings:
+///
+/// RichMessage.text (fun rich -> RecursionE().Format name (rich ty1) (rich ty2) (rich tpcs))
+module internal RichMessage =
+
+ /// Formats a message with no diagnostic number
+ val text: format: ((RichText -> string) -> string) -> RichText
+
+ /// Formats a message with a diagnostic number
+ val numbered: format: ((RichText -> string) -> int * string) -> int * RichText
+
+/// Accumulates rich text. Adjacent parts with the same classification are merged, so that where one
+/// append ended is not visible in the result.
+///
+/// AppendString has the same name and signature as the StringBuilder extension in lib.fs, so that
+/// message formatting code can be moved over to rich text without being rewritten, and can then be
+/// converted to emit classified parts one message at a time.
+[]
+type internal RichTextBuilder =
+
+ new: unit -> RichTextBuilder
+
+ /// Appends unclassified text, tagged TextTag.Text
+ member Append: value: string -> unit
+
+ /// Appends a single tagged part
+ member Append: value: TaggedText -> unit
+
+ /// Appends the parts of another rich text
+ member Append: value: RichText -> unit
+
+ /// Appends a message from FSStrings, classifying each of its arguments. The FSComp accessors are
+ /// generated with overloads taking classified arguments, so those are called directly and their
+ /// result appended; the FSStrings ones are declared by hand and have no such overload.
+ member Append: message: ResourceString string> * a0: RichText -> unit
+
+ /// Appends a message from a resource file, classifying each of its arguments
+ member Append: message: ResourceString string -> string> * a0: RichText * a1: RichText -> unit
+
+ /// Appends a message from a resource file, classifying each of its arguments
+ member Append:
+ message: ResourceString string -> string -> string> * a0: RichText * a1: RichText * a2: RichText ->
+ unit
+
+ /// Appends a message from a resource file, classifying each of its arguments
+ member Append:
+ message: ResourceString string -> string -> string -> string> *
+ a0: RichText *
+ a1: RichText *
+ a2: RichText *
+ a3: RichText ->
+ unit
+
+ /// Appends a message whose arguments are spliced in by the given function, for messages that mix
+ /// classified and plain arguments. See RichMessage.
+ member Append: format: ((RichText -> string) -> string) -> unit
+
+ /// Gets whether nothing has been appended
+ member IsEmpty: bool
+
+ /// Gets the accumulated text
+ member ToRichText: unit -> RichText
diff --git a/src/Compiler/Facilities/TextLayoutRender.fs b/src/Compiler/Facilities/TextLayoutRender.fs
index 7babb76ca29..a3c95148df0 100644
--- a/src/Compiler/Facilities/TextLayoutRender.fs
+++ b/src/Compiler/Facilities/TextLayoutRender.fs
@@ -203,10 +203,9 @@ module LayoutRender =
let bufferL os layout = renderL (bufferR os) layout |> ignore
- let emitL f layout =
- renderL (taggedTextListR f) layout |> ignore
-
let toArray layout =
let output = ResizeArray()
renderL (taggedTextListR output.Add) layout |> ignore
output.ToArray()
+
+ let toRichText layout = RichText.ofParts (toArray layout)
diff --git a/src/Compiler/Facilities/TextLayoutRender.fsi b/src/Compiler/Facilities/TextLayoutRender.fsi
index 96d4b13a184..6692e3d0f02 100644
--- a/src/Compiler/Facilities/TextLayoutRender.fsi
+++ b/src/Compiler/Facilities/TextLayoutRender.fsi
@@ -28,7 +28,7 @@ module internal LayoutRender =
val internal toArray: Layout -> TaggedText[]
- val internal emitL: (TaggedText -> unit) -> Layout -> unit
+ val internal toRichText: Layout -> RichText
val internal mkNav: range -> TaggedText -> TaggedText
diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs
index a41b658cab1..8e289b60f48 100644
--- a/src/Compiler/Interactive/fsi.fs
+++ b/src/Compiler/Interactive/fsi.fs
@@ -342,7 +342,17 @@ type ILMultiInMemoryAssemblyEmitEnv
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 System.Type
@@ -357,7 +367,17 @@ type ILMultiInMemoryAssemblyEmitEnv
let typT = Type.GetType qualifiedName
match typT with
- | null -> error (Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", qualifiedName, ""), range0))
+ | null ->
+ error (
+ RichError(
+ FSComp.SR.itemNotFoundDuringDynamicCodeGen (
+ RichText.mkText "type",
+ RichText.mkQualifiedTypeName qualifiedName,
+ RichText.mkText ""
+ ),
+ range0
+ )
+ )
| res -> res
| ILScopeRef.PrimaryAssembly -> convResolveAssemblyRef ilg.primaryAssemblyRef qualifiedName
@@ -385,7 +405,14 @@ type ILMultiInMemoryAssemblyEmitEnv
match res with
| null ->
error (
- Error(FSComp.SR.itemNotFoundDuringDynamicCodeGen ("type", tspec.TypeRef.QualifiedName, tspec.Scope.QualifiedName), range0)
+ RichError(
+ FSComp.SR.itemNotFoundDuringDynamicCodeGen (
+ RichText.mkText "type",
+ RichText.mkUnknownType tspec.TypeRef.QualifiedName,
+ RichText.mkText tspec.Scope.QualifiedName
+ ),
+ range0
+ )
)
| _ -> res
@@ -3879,7 +3906,13 @@ type FsiInteractionProcessor
| "show" -> fsiConsolePrompt.ShowPrompt <- true
| "hide" -> fsiConsolePrompt.ShowPrompt <- false
| "skip" -> fsiConsolePrompt.SkipNext()
- | _ -> error (Error((FSComp.SR.fsiInvalidDirective ("prompt", String.concat " " [ showPrompt ])), m))
+ | _ ->
+ error (
+ RichError(
+ (FSComp.SR.fsiInvalidDirective (RichText.mkKeyword "prompt", RichText.mkText (String.concat " " [ showPrompt ]))),
+ m
+ )
+ )
istate, Completed None
@@ -3946,13 +3979,16 @@ type FsiInteractionProcessor
match args with
| [] -> fsiOptions.ShowHelp(m)
| [ arg ] -> runhDirective diagnosticsLogger ctok istate arg
- | _ -> warning (Error((FSComp.SR.fsiInvalidDirective ("help", String.concat " " args)), m))
+ | _ ->
+ warning (
+ RichError((FSComp.SR.fsiInvalidDirective (RichText.mkKeyword "help", RichText.mkText (String.concat " " args))), m)
+ )
istate, Completed None
| ParsedHashDirective(c, hashArguments, m) ->
let arg = (parsedHashDirectiveArguments hashArguments tcConfigB.langVersion)
- warning (Error((FSComp.SR.fsiInvalidDirective (c, String.concat " " arg)), m))
+ warning (RichError((FSComp.SR.fsiInvalidDirective (RichText.mkKeyword c, RichText.mkText (String.concat " " arg))), m))
istate, Completed None
/// Most functions return a step status - this decides whether to continue and propagates the
diff --git a/src/Compiler/Optimize/LowerLocalMutables.fs b/src/Compiler/Optimize/LowerLocalMutables.fs
index 169c658c4bc..20152ece692 100644
--- a/src/Compiler/Optimize/LowerLocalMutables.fs
+++ b/src/Compiler/Optimize/LowerLocalMutables.fs
@@ -175,7 +175,7 @@ let TransformImplFile g amap implFile =
implFile
else
for fv in localsToTransform do
- warning (Error(FSComp.SR.abImplicitHeapAllocation(fv.DisplayName), fv.Range))
+ warning (RichError(FSComp.SR.abImplicitHeapAllocation(richTextOfValName g fv), fv.Range))
let heapValMap =
[ for localVal in localsToTransform do
diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs
index 4748685287d..4e0f5b265eb 100644
--- a/src/Compiler/Optimize/Optimizer.fs
+++ b/src/Compiler/Optimize/Optimizer.fs
@@ -633,7 +633,7 @@ let GetInfoForLocalValue cenv env (v: Val) m =
| Some vval -> vval
| None ->
if v.ShouldInline then
- errorR(Error(FSComp.SR.optValueMarkedInlineButWasNotBoundInTheOptEnv(fullDisplayTextOfValRef (mkLocalValRef v)), m))
+ errorR(RichError(FSComp.SR.optValueMarkedInlineButWasNotBoundInTheOptEnv(richTextOfQualifiedValRef (mkLocalValRef v)), m))
UnknownValInfo
let TryGetInfoForCcu env (ccu: CcuThunk) = env.globalModuleInfos.TryFind(ccu.AssemblyName)
@@ -761,7 +761,7 @@ let MakeValueInfoForValue g m vref vinfo =
#if DEBUG
let rec check x =
match x with
- | ValValue (vref2, detail) -> if valRefEq g vref vref2 then error(Error(FSComp.SR.optRecursiveValValue(showL(exprValueInfoL g vinfo)), m)) else check detail
+ | ValValue (vref2, detail) -> if valRefEq g vref vref2 then error(RichError(FSComp.SR.optRecursiveValValue(RichText.mkText (showL(exprValueInfoL g vinfo))), m)) else check detail
| SizeValue (_n, detail) -> check detail
| _ -> ()
check vinfo
@@ -3213,11 +3213,11 @@ and OptimizeVal cenv env expr (v: ValRef, m) =
if cenv.settings.alwaysInline then
if v.ShouldInline then
match valInfoForVal.ValExprInfo with
- | UnknownValue -> error(Error(FSComp.SR.optFailedToInlineValue(v.DisplayName), m))
- | _ -> warning(Error(FSComp.SR.optFailedToInlineValue(v.DisplayName), m))
+ | UnknownValue -> error(RichError(FSComp.SR.optFailedToInlineValue(richTextOfValName g v.Deref), m))
+ | _ -> warning(RichError(FSComp.SR.optFailedToInlineValue(richTextOfValName g v.Deref), m))
if v.InlineIfLambda then
- warning(Error(FSComp.SR.optFailedToInlineSuggestedValue(v.DisplayName), m))
+ warning(RichError(FSComp.SR.optFailedToInlineSuggestedValue(richTextOfValName g v.Deref), m))
expr, (AddValEqualityInfo g m v
{ Info=valInfoForVal.ValExprInfo
@@ -4444,7 +4444,7 @@ and OptimizeBinding cenv isRec env (TBind(vref, expr, spBind)) =
// excluded, as they are expanded transitively when the outer member is inlined.
let fvs = freeInExpr CollectLocals exprOptimized
if fvs.FreeLocals |> Zset.exists (fun v -> not v.ShouldInline && not (canAccessFromEverywhere v.Accessibility)) then
- errorR(Error(FSComp.SR.optValueMarkedInlineButIncomplete(vref.DisplayName), vref.Range))
+ errorR(RichError(FSComp.SR.optValueMarkedInlineButIncomplete(richTextOfValName g vref), vref.Range))
let env = BindInternalLocalVal cenv vref (mkValInfo einfo vref) env
diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs
index c7b36f720e2..e343a8bd348 100644
--- a/src/Compiler/Service/FSharpCheckerResults.fs
+++ b/src/Compiler/Service/FSharpCheckerResults.fs
@@ -2349,7 +2349,7 @@ type internal TypeCheckInfo
let tip = PrintUtilities.squashToWidth width tip
- let tip = LayoutRender.toArray tip
+ let tip = LayoutRender.toRichText tip
ToolTipText.ToolTipText [ ToolTipElement.Single(tip, FSharpXmlDoc.None) ]
| [] ->
@@ -2372,7 +2372,7 @@ type internal TypeCheckInfo
for line in lines ->
let tip = wordL (TaggedText.tagStringLiteral line)
let tip = PrintUtilities.squashToWidth width tip
- let tip = LayoutRender.toArray tip
+ let tip = LayoutRender.toRichText tip
ToolTipElement.Single(tip, FSharpXmlDoc.None)
]
@@ -2921,7 +2921,7 @@ module internal ParseAndCheckFile =
// the formatting of types in it may change (for example, 'a to obj)
//
// So we'll create a diagnostic later, but cache the FormatCore message now
- diagnostic.Exception.Data["CachedFormatCore"] <- diagnostic.FormatCore(flatErrors, suggestNamesForErrors)
+ diagnostic.Exception.Data["CachedFormatCore"] <- diagnostic.FormatRichCore(flatErrors, suggestNamesForErrors)
diagnosticsCollector.Add(diagnostic)
if diagnostic.Severity = FSharpDiagnosticSeverity.Error then
@@ -3471,7 +3471,7 @@ type FSharpCheckFileResults
match Tokenization.FSharpKeywords.KeywordsDescriptionLookup kw with
| None -> ()
| Some kwDescription ->
- let kwText = kw |> TaggedText.tagKeyword |> wordL |> LayoutRender.toArray
+ let kwText = kw |> TaggedText.tagKeyword |> wordL |> LayoutRender.toRichText
yield ToolTipElement.Single(kwText, FSharpXmlDoc.FromXmlText(Xml.XmlDoc([| kwDescription |], range0)))
]
diff --git a/src/Compiler/Service/ServiceDeclarationLists.fs b/src/Compiler/Service/ServiceDeclarationLists.fs
index d8d63b4688a..3742761b964 100644
--- a/src/Compiler/Service/ServiceDeclarationLists.fs
+++ b/src/Compiler/Service/ServiceDeclarationLists.fs
@@ -38,14 +38,14 @@ open FSharp.Compiler.TypedTreeOps
type ToolTipElementData =
{
Symbol: FSharpSymbol option
- MainDescription: TaggedText[]
+ MainDescription: RichText
XmlDoc: FSharpXmlDoc
- TypeMapping: TaggedText[] list
- Remarks: TaggedText[] option
+ TypeMapping: RichText list
+ Remarks: RichText option
ParamName : string option }
- static member internal Create(layout, xml, ?typeMapping, ?paramName, ?remarks, ?symbol) =
- { MainDescription=layout; XmlDoc=xml; TypeMapping=defaultArg typeMapping []; ParamName=paramName; Remarks=remarks; Symbol = symbol }
+ static member internal Create(mainDescription, xml, ?typeMapping, ?paramName, ?remarks, ?symbol) =
+ { MainDescription=mainDescription; XmlDoc=xml; TypeMapping=defaultArg typeMapping []; ParamName=paramName; Remarks=remarks; Symbol = symbol }
/// A single data tip display element
[]
@@ -58,8 +58,8 @@ type ToolTipElement =
/// An error occurred formatting this element
| CompositionError of errorText: string
- static member Single(layout, xml, ?typeMapping, ?paramName, ?remarks, ?symbol) =
- Group [ ToolTipElementData.Create(layout, xml, ?typeMapping=typeMapping, ?paramName=paramName, ?remarks=remarks, ?symbol = symbol) ]
+ static member Single(mainDescription, xml, ?typeMapping, ?paramName, ?remarks, ?symbol) =
+ Group [ ToolTipElementData.Create(mainDescription, xml, ?typeMapping=typeMapping, ?paramName=paramName, ?remarks=remarks, ?symbol = symbol) ]
/// Information for building a data tip box.
type ToolTipText =
@@ -112,9 +112,9 @@ module DeclarationListHelpers =
let xml = GetXmlCommentForMethInfoItem infoReader m item.Item minfo
let tpsL = FormatTyparMapping denv prettyTyparInst
let layout = PrintUtilities.squashToWidth width layout
- let layout = toArray layout
- let tpsL = List.map toArray tpsL
- ToolTipElementData.Create(layout, xml, tpsL, ?symbol = symbol) ]
+ let mainDescription = toRichText layout
+ let typeMapping = List.map toRichText tpsL
+ ToolTipElementData.Create(mainDescription, xml, typeMapping, ?symbol = symbol) ]
ToolTipElement.Group layouts
@@ -171,11 +171,11 @@ module DeclarationListHelpers =
let prettyTyparInst, resL = layoutQualifiedValOrMember denv infoReader item.TyparInstantiation vref
let remarks = OutputFullName displayFullName pubpathOfValRef fullDisplayTextOfValRefAsLayout vref
let tpsL = FormatTyparMapping denv prettyTyparInst
- let tpsL = List.map toArray tpsL
+ let typeMapping = List.map toRichText tpsL
let resL = PrintUtilities.squashToWidth width resL
- let resL = toArray resL
- let remarks = toArray remarks
- ToolTipElement.Single(resL, xml, tpsL, remarks=remarks, ?symbol = symbol)
+ let mainDescription = toRichText resL
+ let remarks = toRichText remarks
+ ToolTipElement.Single(mainDescription, xml, typeMapping, remarks=remarks, ?symbol = symbol)
// Union tags (constructors)
| Item.UnionCase(ucinfo, _) ->
@@ -191,8 +191,8 @@ module DeclarationListHelpers =
(if List.isEmpty recd then emptyL else layoutUnionCases denv infoReader ucinfo.TyconRef recd ^^ WordL.arrow) ^^
layoutType denv unionTy
let layout = PrintUtilities.squashToWidth width layout
- let layout = toArray layout
- ToolTipElement.Single (layout, xml, ?symbol = symbol)
+ let mainDescription = toRichText layout
+ ToolTipElement.Single (mainDescription, xml, ?symbol = symbol)
// Active pattern tag inside the declaration (result)
| Item.ActivePatternResult(apinfo, ty, idx, _) ->
@@ -203,8 +203,8 @@ module DeclarationListHelpers =
RightL.colon ^^
layoutType denv ty
let layout = PrintUtilities.squashToWidth width layout
- let layout = toArray layout
- ToolTipElement.Single (layout, xml, ?symbol = symbol)
+ let mainDescription = toRichText layout
+ ToolTipElement.Single (mainDescription, xml, ?symbol = symbol)
// Active pattern tags
| Item.ActivePatternCase apref ->
@@ -222,19 +222,19 @@ module DeclarationListHelpers =
let tpsL = FormatTyparMapping denv prettyTyparInst
- let layout = toArray layout
- let tpsL = List.map toArray tpsL
- let remarks = toArray remarks
- ToolTipElement.Single (layout, xml, tpsL, remarks=remarks, ?symbol = symbol)
+ let mainDescription = toRichText layout
+ let typeMapping = List.map toRichText tpsL
+ let remarks = toRichText remarks
+ ToolTipElement.Single (mainDescription, xml, typeMapping, remarks=remarks, ?symbol = symbol)
// F# exception names
| Item.ExnCase ecref ->
let layout = layoutExnDef denv infoReader ecref
let layout = PrintUtilities.squashToWidth width layout
let remarks = OutputFullName displayFullName pubpathOfTyconRef fullDisplayTextOfExnRefAsLayout ecref
- let layout = toArray layout
- let remarks = toArray remarks
- ToolTipElement.Single (layout, xml, remarks=remarks, ?symbol = symbol)
+ let mainDescription = toRichText layout
+ let remarks = toRichText remarks
+ ToolTipElement.Single (mainDescription, xml, remarks=remarks, ?symbol = symbol)
| Item.RecdField rfinfo when rfinfo.TyconRef.IsFSharpException ->
let ty, _ = PrettyTypes.PrettifyType g rfinfo.FieldType
@@ -245,8 +245,8 @@ module DeclarationListHelpers =
RightL.colon ^^
layoutType denv ty
let layout = PrintUtilities.squashToWidth width layout
- let layout = toArray layout
- ToolTipElement.Single (layout, xml, paramName = id, ?symbol = symbol)
+ let mainDescription = toRichText layout
+ ToolTipElement.Single (mainDescription, xml, paramName = id, ?symbol = symbol)
// F# record field names
| Item.RecdField rfinfo ->
@@ -264,8 +264,8 @@ module DeclarationListHelpers =
| Some lit -> try WordL.equals ^^ layoutConst denv.g ty lit with _ -> emptyL
)
let layout = PrintUtilities.squashToWidth width layout
- let layout = toArray layout
- ToolTipElement.Single (layout, xml, ?symbol = symbol)
+ let mainDescription = toRichText layout
+ ToolTipElement.Single (mainDescription, xml, ?symbol = symbol)
| Item.UnionCaseField (ucinfo, fieldIndex) ->
let rfield = ucinfo.UnionCase.GetFieldByIndex(fieldIndex)
@@ -277,8 +277,8 @@ module DeclarationListHelpers =
RightL.colon ^^
layoutType denv fieldTy
let layout = PrintUtilities.squashToWidth width layout
- let layout = toArray layout
- ToolTipElement.Single (layout, xml, paramName = id.idText, ?symbol = symbol)
+ let mainDescription = toRichText layout
+ ToolTipElement.Single (mainDescription, xml, paramName = id.idText, ?symbol = symbol)
// Not used
| Item.NewDef id ->
@@ -286,8 +286,8 @@ module DeclarationListHelpers =
wordL (tagText (FSComp.SR.typeInfoPatternVariable())) ^^
wordL (tagUnknownEntity id.idText)
let layout = PrintUtilities.squashToWidth width layout
- let layout = toArray layout
- ToolTipElement.Single (layout, xml, ?symbol = symbol)
+ let mainDescription = toRichText layout
+ ToolTipElement.Single (mainDescription, xml, ?symbol = symbol)
// .NET fields
| Item.ILField finfo ->
@@ -306,8 +306,8 @@ module DeclarationListHelpers =
try layoutConst denv.g (finfo.FieldType(infoReader.amap, m)) (CheckExpressions.TcFieldInit m v) with _ -> emptyL
)
let layout = PrintUtilities.squashToWidth width layout
- let layout = toArray layout
- ToolTipElement.Single (layout, xml, ?symbol = symbol)
+ let mainDescription = toRichText layout
+ ToolTipElement.Single (mainDescription, xml, ?symbol = symbol)
// .NET events
| Item.Event einfo ->
@@ -321,15 +321,15 @@ module DeclarationListHelpers =
RightL.colon ^^
layoutType denv eventTy
let layout = PrintUtilities.squashToWidth width layout
- let layout = toArray layout
- ToolTipElement.Single (layout, xml, ?symbol = symbol)
+ let mainDescription = toRichText layout
+ ToolTipElement.Single (mainDescription, xml, ?symbol = symbol)
// F# and .NET properties
| Item.Property(info = pinfo :: _) ->
let layout = prettyLayoutOfPropInfoFreeStyle g amap m denv pinfo
let layout = PrintUtilities.squashToWidth width layout
- let layout = toArray layout
- ToolTipElement.Single (layout, xml, ?symbol = symbol)
+ let mainDescription = toRichText layout
+ ToolTipElement.Single (mainDescription, xml, ?symbol = symbol)
// Custom operations in queries
| Item.CustomOperation (customOpName, usageText, Some minfo) ->
@@ -342,7 +342,7 @@ module DeclarationListHelpers =
RightL.colon ^^
(
match usageText() with
- | Some t -> wordL (tagText t)
+ | Some t -> wordL (tagText t.Text)
| None ->
let argTys = ParamNameAndTypesOfUnaryCustomOperation g minfo |> List.map (fun (ParamNameAndType(_, ty)) -> ty)
let argTys, _ = PrettyTypes.PrettifyTypes g argTys
@@ -355,8 +355,8 @@ module DeclarationListHelpers =
wordL (tagMethod minfo.DisplayName)
let layout = PrintUtilities.squashToWidth width layout
- let layout = toArray layout
- ToolTipElement.Single (layout, xml, ?symbol = symbol)
+ let mainDescription = toRichText layout
+ ToolTipElement.Single (mainDescription, xml, ?symbol = symbol)
// F# constructors and methods
| Item.CtorGroup(_, minfos)
@@ -373,8 +373,8 @@ module DeclarationListHelpers =
layoutType denv delFuncTy ^^
RightL.rightParen
let layout = PrintUtilities.squashToWidth width layout
- let layout = toArray layout
- ToolTipElement.Single(layout, xml, ?symbol = symbol)
+ let mainDescription = toRichText layout
+ ToolTipElement.Single(mainDescription, xml, ?symbol = symbol)
// Types.
| Item.Types(_, TType_app(tcref, _, _) :: _)
@@ -389,22 +389,22 @@ module DeclarationListHelpers =
let layout = layoutTyconDefn denv infoReader ad m (* width *) tcref.Deref
let layout = PrintUtilities.squashToWidth width layout
let remarks = OutputFullName displayFullName pubpathOfTyconRef fullDisplayTextOfTyconRefAsLayout tcref
- let layout = toArray layout
- let remarks = toArray remarks
- ToolTipElement.Single (layout, xml, remarks=remarks, ?symbol = symbol)
+ let mainDescription = toRichText layout
+ let remarks = toRichText remarks
+ ToolTipElement.Single (mainDescription, xml, remarks=remarks, ?symbol = symbol)
// Type variables
| Item.TypeVar (_, typar) ->
let layout = prettyLayoutOfTypar denv typar
let layout = PrintUtilities.squashToWidth width layout
- ToolTipElement.Single (toArray layout, xml, ?symbol = symbol)
+ ToolTipElement.Single (toRichText layout, xml, ?symbol = symbol)
// Traits
| Item.Trait traitInfo ->
let denv = { denv with shortConstraints = false}
let layout = prettyLayoutOfTrait denv traitInfo
let layout = PrintUtilities.squashToWidth width layout
- ToolTipElement.Single (toArray layout, xml, ?symbol = symbol)
+ ToolTipElement.Single (toRichText layout, xml, ?symbol = symbol)
// F# Modules and namespaces
| Item.ModuleOrNamespaces(modref :: _ as modrefs) ->
@@ -435,21 +435,21 @@ module DeclarationListHelpers =
(
if not (List.isEmpty namesToAdd) then
SepL.lineBreak ^^
- List.fold ( fun s (i, txt) ->
+ List.fold ( fun s (i, txt: string) ->
s ^^
SepL.lineBreak ^^
- wordL (tagText ((if i = 0 then FSComp.SR.typeInfoFromFirst else FSComp.SR.typeInfoFromNext) txt))
+ wordL (tagText (if i = 0 then FSComp.SR.typeInfoFromFirst txt else FSComp.SR.typeInfoFromNext txt))
) emptyL namesToAdd
else
emptyL
)
let layout = PrintUtilities.squashToWidth width layout
- let layout = toArray layout
- ToolTipElement.Single (layout, xml, ?symbol = symbol)
+ let mainDescription = toRichText layout
+ ToolTipElement.Single (mainDescription, xml, ?symbol = symbol)
else
let layout = PrintUtilities.squashToWidth width layout
- let layout = toArray layout
- ToolTipElement.Single (layout, xml, ?symbol = symbol)
+ let mainDescription = toRichText layout
+ ToolTipElement.Single (mainDescription, xml, ?symbol = symbol)
| Item.AnonRecdField(anon, argTys, i, _) ->
let argTy = argTys[i]
@@ -461,8 +461,8 @@ module DeclarationListHelpers =
RightL.colon ^^
layoutType denv argTy
let layout = PrintUtilities.squashToWidth width layout
- let layout = toArray layout
- ToolTipElement.Single (layout, FSharpXmlDoc.None, ?symbol = symbol)
+ let mainDescription = toRichText layout
+ ToolTipElement.Single (mainDescription, FSharpXmlDoc.None, ?symbol = symbol)
// Named parameters
| Item.OtherName (ident = Some id; argType = argTy) ->
@@ -473,8 +473,8 @@ module DeclarationListHelpers =
RightL.colon ^^
layoutType denv argTy
let layout = PrintUtilities.squashToWidth width layout
- let layout = toArray layout
- ToolTipElement.Single (layout, xml, paramName = id.idText, ?symbol = symbol)
+ let mainDescription = toRichText layout
+ ToolTipElement.Single (mainDescription, xml, paramName = id.idText, ?symbol = symbol)
| Item.SetterArg (_, item) ->
FormatItemDescriptionToToolTipElement displayFullName infoReader ad m denv (ItemWithNoInst item) symbol width
@@ -526,7 +526,7 @@ module DeclarationListHelpers =
/// Represents one parameter for one method (or other item) in a group.
[]
-type MethodGroupItemParameter(name: string, canonicalTypeTextForSorting: string, display: TaggedText[], isOptional: bool) =
+type MethodGroupItemParameter(name: string, canonicalTypeTextForSorting: string, display: RichText, isOptional: bool) =
/// The name of the parameter.
member _.ParameterName = name
@@ -558,7 +558,7 @@ module internal DescriptionListsImpl =
let PrettyParamOfRecdField g denv (f: RecdField) =
let display = prettyLayoutOfType denv f.FormalType
- let display = toArray display
+ let display = toRichText display
MethodGroupItemParameter(
name = f.DisplayNameCore,
canonicalTypeTextForSorting = printCanonicalizedTypeName g denv f.FormalType,
@@ -572,7 +572,7 @@ module internal DescriptionListsImpl =
initial.Display
else
let display = layoutOfParamData denv (ParamData(false, false, false, NotOptional, NoCallerInfo, Some f.Id, ReflectedArgInfo.None, f.FormalType))
- toArray display
+ toRichText display
MethodGroupItemParameter(
name=initial.ParameterName,
@@ -582,7 +582,7 @@ module internal DescriptionListsImpl =
let ParamOfParamData g denv (ParamData(_isParamArrayArg, _isInArg, _isOutArg, optArgInfo, _callerInfo, nmOpt, _reflArgInfo, pty) as paramData) =
let display = layoutOfParamData denv paramData
- let display = toArray display
+ let display = toRichText display
MethodGroupItemParameter(
name = (match nmOpt with None -> "" | Some pn -> pn.idText),
canonicalTypeTextForSorting = printCanonicalizedTypeName g denv pty,
@@ -629,7 +629,7 @@ module internal DescriptionListsImpl =
let prettyParams =
(paramInfo, prettyParamTys, prettyParamTysL) |||> List.map3 (fun (nm, isOptArg, paramPrefix) tauTy tyL ->
let display = paramPrefix ^^ tyL
- let display = toArray display
+ let display = toRichText display
MethodGroupItemParameter(
name = nm,
canonicalTypeTextForSorting = printCanonicalizedTypeName g denv tauTy,
@@ -649,7 +649,7 @@ module internal DescriptionListsImpl =
let parameters =
(prettyParamTys, prettyParamTysL)
||> List.map2 (fun paramTy tyL ->
- let display = toArray tyL
+ let display = toRichText tyL
MethodGroupItemParameter(
name = "",
canonicalTypeTextForSorting = printCanonicalizedTypeName g denv paramTy,
@@ -676,7 +676,7 @@ module internal DescriptionListsImpl =
let spName = sp.PUntaint((fun sp -> sp.Name), m)
let spOpt = sp.PUntaint((fun sp -> sp.IsOptional), m)
let display = (if spOpt then SepL.questionMark else emptyL) ^^ wordL (tagParameter spName) ^^ RightL.colon ^^ spKind
- let display = toArray display
+ let display = toRichText display
MethodGroupItemParameter(
name = spName,
canonicalTypeTextForSorting = showL spKind,
@@ -1023,7 +1023,7 @@ type DeclarationListItem(textInDeclList: string, textInCode: string, fullName: s
member _.Description =
match kind, info with
| CompletionItemKind.SuggestedName, _ ->
- ToolTipText [ ToolTipElement.Single ([| tagText (FSComp.SR.suggestedName()) |], FSharpXmlDoc.None) ]
+ ToolTipText [ ToolTipElement.Single (RichText.mkText (FSComp.SR.suggestedName()), FSharpXmlDoc.None) ]
| _, Choice1Of2 (items: CompletionItem list, infoReader, ad, m, denv) ->
ToolTipText(items |> List.map (fun x -> FormatStructuredDescriptionOfItem true infoReader ad m denv x.ItemWithInst None None))
| _, Choice2Of2 result ->
@@ -1272,7 +1272,7 @@ type DeclarationListInfo(declarations: DeclarationListItem[], isForType: bool, i
// Note: instances of this type do not hold any references to any compiler resources.
[]
type MethodGroupItem(description: ToolTipText, xmlDoc: FSharpXmlDoc,
- returnType: TaggedText[], parameters: MethodGroupItemParameter[],
+ returnType: RichText, parameters: MethodGroupItemParameter[],
hasParameters: bool, hasParamArrayArg: bool, staticParameters: MethodGroupItemParameter[]) =
/// The description representation for the method (or other item)
@@ -1365,10 +1365,10 @@ type MethodGroup( name: string, unsortedMethods: MethodGroupItem[] ) =
#endif
| _ -> true
- let prettyRetTyL = toArray prettyRetTyL
+ let returnType = toRichText prettyRetTyL
MethodGroupItem(
description = description,
- returnType = prettyRetTyL,
+ returnType = returnType,
xmlDoc = GetXmlCommentForItem infoReader m flatItem,
parameters = (prettyParams |> Array.ofList),
hasParameters = hasStaticParameters,
diff --git a/src/Compiler/Service/ServiceDeclarationLists.fsi b/src/Compiler/Service/ServiceDeclarationLists.fsi
index fbf74a4ab75..a81764dfa0d 100644
--- a/src/Compiler/Service/ServiceDeclarationLists.fsi
+++ b/src/Compiler/Service/ServiceDeclarationLists.fsi
@@ -19,21 +19,21 @@ type public ToolTipElementData =
{
Symbol: FSharpSymbol option
- MainDescription: TaggedText[]
+ MainDescription: RichText
XmlDoc: FSharpXmlDoc
/// typar instantiation text, to go after xml
- TypeMapping: TaggedText[] list
+ TypeMapping: RichText list
/// Extra text, goes at the end
- Remarks: TaggedText[] option
+ Remarks: RichText option
/// Parameter name
ParamName: string option
}
- static member internal Create: layout: TaggedText[] * xml: FSharpXmlDoc * ?typeMapping: TaggedText[] list * ?paramName: string * ?remarks: TaggedText[] * ?symbol: FSharpSymbol -> ToolTipElementData
+ static member internal Create: mainDescription: RichText * xml: FSharpXmlDoc * ?typeMapping: RichText list * ?paramName: string * ?remarks: RichText * ?symbol: FSharpSymbol -> ToolTipElementData
/// A single tool tip display element
//
@@ -48,7 +48,7 @@ type public ToolTipElement =
/// An error occurred formatting this element
| CompositionError of errorText: string
- static member Single: layout: TaggedText[] * xml: FSharpXmlDoc * ?typeMapping: TaggedText[] list * ?paramName: string * ?remarks: TaggedText[] * ?symbol: FSharpSymbol -> ToolTipElement
+ static member Single: mainDescription: RichText * xml: FSharpXmlDoc * ?typeMapping: RichText list * ?paramName: string * ?remarks: RichText * ?symbol: FSharpSymbol -> ToolTipElement
/// Information for building a tool tip box.
//
@@ -184,7 +184,7 @@ type public MethodGroupItemParameter =
/// The representation for the parameter including its name, its type and visual indicators of other
/// information such as whether it is optional.
- member Display: TaggedText[]
+ member Display: RichText
/// Is the parameter optional
member IsOptional: bool
@@ -201,7 +201,7 @@ type public MethodGroupItem =
member Description: ToolTipText
/// The tagged text for the return type for the method (or other item)
- member ReturnTypeText: TaggedText[]
+ member ReturnTypeText: RichText
/// The parameters of the method in the overload set
member Parameters: MethodGroupItemParameter[]
diff --git a/src/Compiler/Symbols/FSharpDiagnostic.fs b/src/Compiler/Symbols/FSharpDiagnostic.fs
index 06097f35ad0..37cc6ed3698 100644
--- a/src/Compiler/Symbols/FSharpDiagnostic.fs
+++ b/src/Compiler/Symbols/FSharpDiagnostic.fs
@@ -131,11 +131,12 @@ module ExtendedData =
open ExtendedData
-type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, defaultSeverity: FSharpDiagnosticSeverity, message: string, subcategory: string, errorNum: int, numberPrefix: string, extendedData: IFSharpDiagnosticExtendedData option) =
+type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, defaultSeverity: FSharpDiagnosticSeverity, message: RichText, subcategory: string, errorNum: int, numberPrefix: string, extendedData: IFSharpDiagnosticExtendedData option) =
member _.Range = m
member _.Severity = severity
member _.DefaultSeverity = defaultSeverity
- member _.Message = message
+ member _.Message = message.Text
+ member _.RichMessage = message
member _.Subcategory = subcategory
member _.ErrorNumber = errorNum
member _.ErrorNumberPrefix = numberPrefix
@@ -168,7 +169,7 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, defaultSever
| FSharpDiagnosticSeverity.Error -> "error"
| FSharpDiagnosticSeverity.Info -> "info"
| FSharpDiagnosticSeverity.Hidden -> "hidden"
- sprintf "%s (%d,%d)-(%d,%d) %s %s %s" fileName s.Line (s.Column + 1) e.Line (e.Column + 1) subcategory severity message
+ sprintf "%s (%d,%d)-(%d,%d) %s %s %s" fileName s.Line (s.Column + 1) e.Line (e.Column + 1) subcategory severity message.Text
/// Decompose a warning or error into parts: position, severity, message, error number
static member CreateFromException(diagnostic: PhasedDiagnostic, suggestNames: bool, flatErrors: bool, symbolEnv: SymbolEnv option) =
@@ -228,8 +229,8 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, defaultSever
let msg =
match diagnostic.Exception.Data["CachedFormatCore"] with
- | :? string as message -> message
- | _ -> diagnostic.FormatCore(flatErrors, suggestNames)
+ | :? RichText as message -> message
+ | _ -> diagnostic.FormatRichCore(flatErrors, suggestNames)
let errorNum = diagnostic.Number
let m = match diagnostic.Range with Some m -> m.ApplyLineDirectives() | None -> range0
@@ -239,7 +240,12 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, defaultSever
static member NormalizeErrorString(text) = NormalizeErrorString(text)
- static member Create(severity, message, number, range, ?numberPrefix, ?subcategory) =
+ static member Create(severity, message: string, number, range, ?numberPrefix, ?subcategory) =
+ let subcategory = defaultArg subcategory BuildPhaseSubcategory.TypeCheck
+ let numberPrefix = defaultArg numberPrefix "FS"
+ FSharpDiagnostic(range, severity, severity, RichText.mkText message, subcategory, number, numberPrefix, None)
+
+ static member Create(severity, message: RichText, number, range, ?numberPrefix, ?subcategory) =
let subcategory = defaultArg subcategory BuildPhaseSubcategory.TypeCheck
let numberPrefix = defaultArg numberPrefix "FS"
FSharpDiagnostic(range, severity, severity, message, subcategory, number, numberPrefix, None)
diff --git a/src/Compiler/Symbols/FSharpDiagnostic.fsi b/src/Compiler/Symbols/FSharpDiagnostic.fsi
index 35b96efe629..124506ca6c6 100644
--- a/src/Compiler/Symbols/FSharpDiagnostic.fsi
+++ b/src/Compiler/Symbols/FSharpDiagnostic.fsi
@@ -202,6 +202,10 @@ type FSharpDiagnostic =
/// Gets the message for the diagnostic
member Message: string
+ /// Gets the message for the diagnostic as parts classified by their kind, e.g. so that tooling is
+ /// able to render it with colors. Message is the text of all parts concatenated.
+ member RichMessage: RichText
+
/// Gets the subcategory for the diagnostic
member Subcategory: string
@@ -228,6 +232,17 @@ type FSharpDiagnostic =
?subcategory: string ->
FSharpDiagnostic
+ /// Creates a diagnostic whose message parts are classified by their kind, e.g. so that tooling is
+ /// able to render it with colors
+ static member Create:
+ severity: FSharpDiagnosticSeverity *
+ message: RichText *
+ number: int *
+ range: range *
+ ?numberPrefix: string *
+ ?subcategory: string ->
+ FSharpDiagnostic
+
static member internal CreateFromException:
diagnostic: PhasedDiagnostic * suggestNames: bool * flatErrors: bool * symbolEnv: SymbolEnv option ->
FSharpDiagnostic
diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs
index 41fba62c590..b6d43c9917b 100644
--- a/src/Compiler/Symbols/Symbols.fs
+++ b/src/Compiler/Symbols/Symbols.fs
@@ -2403,11 +2403,11 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) =
prefix + x.LogicalName
with _ -> "??"
- member x.FormatLayout (displayContext: FSharpDisplayContext) =
+ member x.FormatRichText (displayContext: FSharpDisplayContext) =
match x.IsMember, d with
| true, V v ->
NicePrint.prettyLayoutOfMemberNoInstShort { (displayContext.Contents cenv.g) with showMemberContainers=true } v.Deref
- |> LayoutRender.toArray
+ |> LayoutRender.toRichText
| _,_ ->
checkIsResolved()
let ty =
@@ -2420,9 +2420,9 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) =
mkIteratedFunTy cenv.g (List.map (mkRefTupledTy cenv.g) argTysl) retTy
| V v -> v.TauType
NicePrint.prettyLayoutOfTypeNoCx (displayContext.Contents cenv.g) ty
- |> LayoutRender.toArray
+ |> LayoutRender.toRichText
- member x.GetReturnTypeLayout (displayContext: FSharpDisplayContext) =
+ member x.GetReturnTypeRichText (displayContext: FSharpDisplayContext) =
checkIsResolved()
match d with
| E _
@@ -2431,11 +2431,11 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) =
| M m ->
let retTy = m.GetFSharpReturnType(cenv.amap, range0, m.FormalMethodInst)
NicePrint.layoutType (displayContext.Contents cenv.g) retTy
- |> LayoutRender.toArray
+ |> LayoutRender.toRichText
|> Some
| V v ->
NicePrint.layoutOfValReturnType (displayContext.Contents cenv.g) v
- |> LayoutRender.toArray
+ |> LayoutRender.toRichText
|> Some
member x.GetValSignatureText (displayContext: FSharpDisplayContext, m: range) =
@@ -2801,15 +2801,15 @@ type FSharpType(cenv, ty:TType) =
protect <| fun () ->
NicePrint.prettyStringOfTy (context.Contents cenv.g) ty
- member _.FormatLayout(context: FSharpDisplayContext) =
+ member _.FormatRichText(context: FSharpDisplayContext) =
protect <| fun () ->
NicePrint.prettyLayoutOfTypeNoCx (context.Contents cenv.g) ty
- |> LayoutRender.toArray
+ |> LayoutRender.toRichText
- member _.FormatLayoutWithConstraints(context: FSharpDisplayContext) =
+ member _.FormatRichTextWithConstraints(context: FSharpDisplayContext) =
protect <| fun () ->
NicePrint.prettyLayoutOfType (context.Contents cenv.g) ty
- |> LayoutRender.toArray
+ |> LayoutRender.toRichText
override _.ToString() =
protect <| fun () ->
diff --git a/src/Compiler/Symbols/Symbols.fsi b/src/Compiler/Symbols/Symbols.fsi
index 8ce2cf390b4..a01d72242a1 100644
--- a/src/Compiler/Symbols/Symbols.fsi
+++ b/src/Compiler/Symbols/Symbols.fsi
@@ -998,10 +998,10 @@ type FSharpMemberOrFunctionOrValue =
member IsConstructor: bool
/// Format the type using the rules of the given display context
- member FormatLayout: displayContext: FSharpDisplayContext -> TaggedText[]
+ member FormatRichText: displayContext: FSharpDisplayContext -> RichText
/// Format the type using the rules of the given display context
- member GetReturnTypeLayout: displayContext: FSharpDisplayContext -> TaggedText[] option
+ member GetReturnTypeRichText: displayContext: FSharpDisplayContext -> RichText option
/// Get the signature text to include this Symbol into an existing signature file.
member GetValSignatureText: displayContext: FSharpDisplayContext * m: range -> string option
@@ -1171,10 +1171,10 @@ type FSharpType =
member FormatWithConstraints: context: FSharpDisplayContext -> string
/// Format the type using the rules of the given display context
- member FormatLayout: context: FSharpDisplayContext -> TaggedText[]
+ member FormatRichText: context: FSharpDisplayContext -> RichText
/// Format the type - with constraints - using the rules of the given display context
- member FormatLayoutWithConstraints: context: FSharpDisplayContext -> TaggedText[]
+ member FormatRichTextWithConstraints: context: FSharpDisplayContext -> RichText
/// Instantiate generic type parameters in a type
member Instantiate: (FSharpGenericParameter * FSharpType) list -> FSharpType
diff --git a/src/Compiler/SyntaxTree/LexHelpers.fs b/src/Compiler/SyntaxTree/LexHelpers.fs
index 67bb21789c3..8ad7501c7fe 100644
--- a/src/Compiler/SyntaxTree/LexHelpers.fs
+++ b/src/Compiler/SyntaxTree/LexHelpers.fs
@@ -291,7 +291,7 @@ let escape c =
// Keyword table
//-----------------------------------------------------------------------
-exception ReservedKeyword of string * range
+exception ReservedKeyword of RichText * range
module Keywords =
type private compatibilityMode =
@@ -426,7 +426,7 @@ module Keywords =
| true, v ->
match v with
| RESERVED ->
- warning (ReservedKeyword(FSComp.SR.lexhlpIdentifierReserved (s), lexbuf.LexemeRange))
+ warning (ReservedKeyword(FSComp.SR.lexhlpIdentifierReserved (RichText.mkKeyword s), lexbuf.LexemeRange))
IdentifierToken args lexbuf s
| _ -> v
| _ ->
diff --git a/src/Compiler/SyntaxTree/LexHelpers.fsi b/src/Compiler/SyntaxTree/LexHelpers.fsi
index 2adc11d5b13..f2dae34bfd8 100644
--- a/src/Compiler/SyntaxTree/LexHelpers.fsi
+++ b/src/Compiler/SyntaxTree/LexHelpers.fsi
@@ -105,7 +105,7 @@ val unicodeGraphLong: string -> LongUnicodeLexResult
val escape: char -> char
-exception ReservedKeyword of string * range
+exception ReservedKeyword of RichText * range
module Keywords =
diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fs b/src/Compiler/SyntaxTree/ParseHelpers.fs
index b329d48ee34..63addac085f 100644
--- a/src/Compiler/SyntaxTree/ParseHelpers.fs
+++ b/src/Compiler/SyntaxTree/ParseHelpers.fs
@@ -738,7 +738,7 @@ let mkRecdField (lidwd: SynLongIdent) = lidwd, true
// Used for 'do expr' in a class.
let mkSynDoBinding (vis: SynAccess option, mDo, expr, m) =
match vis with
- | Some vis -> errorR (Error(FSComp.SR.parsDoCannotHaveVisibilityDeclarations (vis |> string), m))
+ | Some vis -> errorR (RichError(FSComp.SR.parsDoCannotHaveVisibilityDeclarations (RichText.mkKeyword (vis |> string)), m))
| None -> ()
SynBinding(
diff --git a/src/Compiler/SyntaxTree/WarnScopes.fs b/src/Compiler/SyntaxTree/WarnScopes.fs
index a0d9a773714..3dac642c14a 100644
--- a/src/Compiler/SyntaxTree/WarnScopes.fs
+++ b/src/Compiler/SyntaxTree/WarnScopes.fs
@@ -81,7 +81,7 @@ module internal WarnScopes =
None
| false, _ -> Some(s, s)
- let parseInt (intString: string, argString) =
+ let parseInt (intString: string, argString: string) =
match System.Int32.TryParse intString with
| true, i -> Some i
| false, _ ->
@@ -143,7 +143,7 @@ module internal WarnScopes =
| "warnon" -> argCaptures |> List.choose (mkDirective WarnCmd.Warnon)
| "nowarn" -> argCaptures |> List.choose (mkDirective WarnCmd.Nowarn)
| _ -> // like "warnonx"
- errorR (Error(FSComp.SR.fsiInvalidDirective ($"#{dIdent}", ""), directiveRange))
+ errorR (RichError(FSComp.SR.fsiInvalidDirective (RichText.mkKeyword $"#{dIdent}", RichText.empty), directiveRange))
[]
{
@@ -244,7 +244,9 @@ module internal WarnScopes =
| WarnScope.OpenOff m' :: _
| WarnScope.On m' :: _ ->
if scopedNowarnFeatureIsSupported then
- informationalWarning (Error(FSComp.SR.lexWarnDirectivesMustMatch ("#nowarn", m'.StartLine), m))
+ informationalWarning (
+ RichError(FSComp.SR.lexWarnDirectivesMustMatch (RichText.mkKeyword "#nowarn", m'.StartLine), m)
+ )
warnScopeMap
| scopes -> warnScopeMap.Add(n, WarnScope.OpenOff(mkScope m m) :: scopes)
@@ -253,7 +255,7 @@ module internal WarnScopes =
| WarnScope.OpenOff m' :: t -> warnScopeMap.Add(n, WarnScope.Off(mkScope m' m) :: t)
| WarnScope.OpenOn m' :: _
| WarnScope.Off m' :: _ ->
- warning (Error(FSComp.SR.lexWarnDirectivesMustMatch ("#warnon", m'.EndLine), m))
+ warning (RichError(FSComp.SR.lexWarnDirectivesMustMatch (RichText.mkKeyword "#warnon", m'.EndLine), m))
warnScopeMap
| scopes -> warnScopeMap.Add(n, WarnScope.OpenOn(mkScope m m) :: scopes)
diff --git a/src/Compiler/SyntaxTree/XmlDoc.fs b/src/Compiler/SyntaxTree/XmlDoc.fs
index b3ef13d7a4c..7d89432124b 100644
--- a/src/Compiler/SyntaxTree/XmlDoc.fs
+++ b/src/Compiler/SyntaxTree/XmlDoc.fs
@@ -84,7 +84,7 @@ type XmlDoc(unprocessedLines: string[], range: range) =
let nm = attr.Value
if not (paramNames |> List.contains nm) then
- warning (Error(FSComp.SR.xmlDocInvalidParameterName nm, doc.Range))
+ warning (RichError(FSComp.SR.xmlDocInvalidParameterName (RichText.mkParameter nm), doc.Range))
let paramsWithDocs =
[
@@ -98,12 +98,12 @@ type XmlDoc(unprocessedLines: string[], range: range) =
for p in paramNames do
if not (paramsWithDocs |> List.contains p) then
- warning (Error(FSComp.SR.xmlDocMissingParameter p, doc.Range))
+ warning (RichError(FSComp.SR.xmlDocMissingParameter (RichText.mkParameter p), doc.Range))
let duplicates = paramsWithDocs |> List.duplicates
for d in duplicates do
- warning (Error(FSComp.SR.xmlDocDuplicateParameter d, doc.Range))
+ warning (RichError(FSComp.SR.xmlDocDuplicateParameter (RichText.mkParameter d), doc.Range))
for pref in xml.Descendants(XName.op_Implicit "paramref") do
match pref.Attribute(!!(XName.op_Implicit "name")) with
@@ -112,7 +112,7 @@ type XmlDoc(unprocessedLines: string[], range: range) =
let nm = attr.Value
if not (paramNames |> List.contains nm) then
- warning (Error(FSComp.SR.xmlDocInvalidParameterName nm, doc.Range))
+ warning (RichError(FSComp.SR.xmlDocInvalidParameterName (RichText.mkParameter nm), doc.Range))
with e ->
warning (Error(FSComp.SR.xmlDocBadlyFormed e.Message, doc.Range))
diff --git a/src/Compiler/TypedTree/TypeProviders.fs b/src/Compiler/TypedTree/TypeProviders.fs
index 5491ae2a322..1172605f26f 100644
--- a/src/Compiler/TypedTree/TypeProviders.fs
+++ b/src/Compiler/TypedTree/TypeProviders.fs
@@ -59,10 +59,10 @@ let GetTypeProviderImplementationTypes (
let exnMsg = e.Message
match designTimeAssemblyPathOpt with
| None ->
- let msg = FSComp.SR.etProviderHasWrongDesignerAssemblyNoPath(attrName, designTimeAssemblyNameString, exnTypeName, exnMsg)
+ let msg = FSComp.SR.etProviderHasWrongDesignerAssemblyNoPath(RichText.mkClass attrName, RichText.mkText designTimeAssemblyNameString, RichText.mkText exnTypeName, RichText.mkText exnMsg)
raise (TypeProviderError(msg, runTimeAssemblyFileName, m))
| Some designTimeAssemblyPath ->
- let msg = FSComp.SR.etProviderHasWrongDesignerAssembly(attrName, designTimeAssemblyNameString, designTimeAssemblyPath, exnTypeName, exnMsg)
+ let msg = FSComp.SR.etProviderHasWrongDesignerAssembly(RichText.mkClass attrName, RichText.mkText designTimeAssemblyNameString, RichText.mkText designTimeAssemblyPath, RichText.mkText exnTypeName, RichText.mkText exnMsg)
raise (TypeProviderError(msg, runTimeAssemblyFileName, m))
let designTimeAssemblyOpt = getTypeProviderAssembly (runTimeAssemblyFileName, designTimeAssemblyNameString, compilerToolPaths, raiseError)
@@ -85,11 +85,11 @@ let GetTypeProviderImplementationTypes (
let exnMsg = e.Message
match e with
| :? FileLoadException ->
- let msg = FSComp.SR.etProviderHasDesignerAssemblyDependency(designTimeAssemblyNameString, folder, exnTypeName, exnMsg)
+ let msg = FSComp.SR.etProviderHasDesignerAssemblyDependency(RichText.mkText designTimeAssemblyNameString, RichText.mkText folder, RichText.mkText exnTypeName, RichText.mkText exnMsg)
raise (TypeProviderError(msg, runTimeAssemblyFileName, m))
| _ ->
- let msg = FSComp.SR.etProviderHasDesignerAssemblyException(designTimeAssemblyNameString, folder, exnTypeName, exnMsg)
+ let msg = FSComp.SR.etProviderHasDesignerAssemblyException(RichText.mkText designTimeAssemblyNameString, RichText.mkText folder, RichText.mkText exnTypeName, RichText.mkText exnMsg)
raise (TypeProviderError(msg, runTimeAssemblyFileName, m))
| None -> []
@@ -119,7 +119,7 @@ let CreateTypeProvider (
f ()
with err ->
let e = StripException (StripException err)
- raise (TypeProviderError(FSComp.SR.etTypeProviderConstructorException(e.Message), !! typeProviderImplementationType.FullName, m))
+ raise (TypeProviderError(FSComp.SR.etTypeProviderConstructorException(RichText.mkText e.Message), !! typeProviderImplementationType.FullName, m))
let getReferencedAssemblies () =
resolutionEnvironment.GetReferencedAssemblies() |> Array.distinct
@@ -168,7 +168,7 @@ let GetTypeProvidersOfAssembly (
else
Some (AssemblyName designTimeName)
with :? ArgumentException ->
- errorR(Error(FSComp.SR.etInvalidTypeProviderAssemblyName(runtimeAssemblyFilename, designTimeName), m))
+ errorR(RichError(FSComp.SR.etInvalidTypeProviderAssemblyName(RichText.mkText runtimeAssemblyFilename, RichText.mkText designTimeName), m))
None
[
@@ -194,7 +194,7 @@ let GetTypeProvidersOfAssembly (
]
with :? TypeProviderError as tpe ->
- tpe.Iter(fun e -> errorR(Error((e.Number, e.ContextualErrorMessage), m)) )
+ tpe.Iter(fun e -> errorR(RichError((e.Number, e.ContextualErrorRichMessage), m)) )
[]
let providers = Tainted<_>.CreateAll(providerSpecs)
@@ -208,7 +208,7 @@ let TryTypeMember<'T,'U>(st: Tainted<'T>, fullName, memberName, m, recover, f: '
try
st.PApply (f, m)
with :? TypeProviderError as tpe ->
- tpe.Iter (fun e -> errorR(Error(FSComp.SR.etUnexpectedExceptionFromProvidedTypeMember(fullName, memberName, e.ContextualErrorMessage), m)))
+ tpe.Iter (fun e -> errorR(RichError(FSComp.SR.etUnexpectedExceptionFromProvidedTypeMember(RichText.mkQualifiedTypeName fullName, RichText.mkMember memberName, e.ContextualErrorRichMessage), m)))
st.PApplyNoFailure(fun _ -> recover)
/// Try to access a member on a provided type, where the result is an array of values, catching and reporting errors
@@ -216,7 +216,7 @@ let TryTypeMemberArray (st: Tainted<_>, fullName, memberName, m, f) =
try
st.PApplyArray(f, memberName, m)
with :? TypeProviderError as tpe ->
- tpe.Iter (fun e -> error(Error(FSComp.SR.etUnexpectedExceptionFromProvidedTypeMember(fullName, memberName, e.ContextualErrorMessage), m)))
+ tpe.Iter (fun e -> error(RichError(FSComp.SR.etUnexpectedExceptionFromProvidedTypeMember(RichText.mkQualifiedTypeName fullName, RichText.mkMember memberName, e.ContextualErrorRichMessage), m)))
[||]
/// Try to access a member on a provided type, catching and reporting errors and checking the result is non-null,
@@ -224,7 +224,7 @@ let TryTypeMemberNonNull<'T, 'U when 'U : not null and 'U : not struct>(st: Tain
f: 'T -> 'U | null) : Tainted<'U> =
match TryTypeMember<'T, 'U | null>(st, fullName, memberName, m, withNull recover, f) with
| Tainted.Null ->
- errorR(Error(FSComp.SR.etUnexpectedNullFromProvidedTypeMember(fullName, memberName), m))
+ errorR(RichError(FSComp.SR.etUnexpectedNullFromProvidedTypeMember(RichText.mkQualifiedTypeName fullName, RichText.mkMember memberName), m))
st.PApplyNoFailure(fun _ -> recover)
| Tainted.NonNull r ->
r
@@ -234,7 +234,7 @@ let TryMemberMember (mi: Tainted<_>, typeName, memberName, memberMemberName, m,
try
mi.PApply (f, m)
with :? TypeProviderError as tpe ->
- tpe.Iter (fun e -> errorR(Error(FSComp.SR.etUnexpectedExceptionFromProvidedMemberMember(memberMemberName, typeName, memberName, e.ContextualErrorMessage), m)))
+ tpe.Iter (fun e -> errorR(RichError(FSComp.SR.etUnexpectedExceptionFromProvidedMemberMember(RichText.mkMember memberMemberName, RichText.mkQualifiedTypeName typeName, RichText.mkMember memberName, e.ContextualErrorRichMessage), m)))
mi.PApplyNoFailure(fun _ -> recover)
/// Get the string to show for the name of a type provider
@@ -248,12 +248,12 @@ let ValidateNamespaceName(name, typeProvider: Tainted, m, nsp: st
| NonNull nsp ->
if String.IsNullOrWhiteSpace nsp then
// Empty namespace is not allowed
- errorR(Error(FSComp.SR.etEmptyNamespaceOfTypeNotAllowed(name, typeProvider.PUntaint((fun tp -> tp.GetType().Name), m)), m))
+ errorR(RichError(FSComp.SR.etEmptyNamespaceOfTypeNotAllowed(RichText.mkQualifiedTypeName name, RichText.mkText (typeProvider.PUntaint((fun tp -> tp.GetType().Name), m))), m))
else
for s in nsp.Split('.') do
match s.IndexOfAny(PrettyNaming.IllegalCharactersInTypeAndNamespaceNames) with
| -1 -> ()
- | n -> errorR(Error(FSComp.SR.etIllegalCharactersInNamespaceName(string s[n], s), m))
+ | n -> errorR(RichError(FSComp.SR.etIllegalCharactersInNamespaceName(RichText.mkText (string s[n]), RichText.mkNamespace s), m))
let bindingFlags =
BindingFlags.DeclaredOnly |||
@@ -1032,26 +1032,26 @@ let CheckAndComputeProvidedNameProperty(m, st: Tainted, proj, prop
let name : string | null =
try st.PUntaint(proj, m)
with :? TypeProviderError as tpe ->
- let newError = tpe.MapText((fun msg -> FSComp.SR.etProvidedTypeWithNameException(propertyString, msg)), st.TypeProviderDesignation, m)
+ let newError = tpe.MapText((fun msg -> FSComp.SR.etProvidedTypeWithNameException(RichText.mkMember propertyString, msg)), st.TypeProviderDesignation, m)
raise newError
if String.IsNullOrEmpty name then
- raise (TypeProviderError(FSComp.SR.etProvidedTypeWithNullOrEmptyName propertyString, st.TypeProviderDesignation, m))
+ raise (TypeProviderError(FSComp.SR.etProvidedTypeWithNullOrEmptyName (RichText.mkMember propertyString), st.TypeProviderDesignation, m))
!!name
/// Verify that this type provider has supported attributes
let ValidateAttributesOfProvidedType (m, st: Tainted) =
let fullName = CheckAndComputeProvidedNameProperty(m, st, (fun st -> st.FullName), "FullName")
if TryTypeMember(st, fullName, "IsGenericType", m, false, fun st->st.IsGenericType) |> unmarshal then
- errorR(Error(FSComp.SR.etMustNotBeGeneric fullName, m))
+ errorR(RichError(FSComp.SR.etMustNotBeGeneric (RichText.mkQualifiedTypeName fullName), m))
if TryTypeMember(st, fullName, "IsArray", m, false, fun st->st.IsArray) |> unmarshal then
- errorR(Error(FSComp.SR.etMustNotBeAnArray fullName, m))
+ errorR(RichError(FSComp.SR.etMustNotBeAnArray (RichText.mkQualifiedTypeName fullName), m))
TryTypeMemberNonNull(st, fullName, "GetInterfaces", m, [||], fun st -> st.GetInterfaces()) |> ignore
/// Verify that a provided type has the expected name
let ValidateExpectedName m expectedPath expectedName (st: Tainted) =
let name = CheckAndComputeProvidedNameProperty(m, st, (fun st -> st.Name), "Name")
if name <> expectedName then
- raise (TypeProviderError(FSComp.SR.etProvidedTypeHasUnexpectedName(expectedName, name), st.TypeProviderDesignation, m))
+ raise (TypeProviderError(FSComp.SR.etProvidedTypeHasUnexpectedName(RichText.mkQualifiedTypeName expectedName, RichText.mkQualifiedTypeName name), st.TypeProviderDesignation, m))
let namespaceName = TryTypeMember(st, name, "Namespace", m, ("":_|null), fun st -> st.Namespace) |> unmarshal
@@ -1071,7 +1071,7 @@ let ValidateExpectedName m expectedPath expectedName (st: Tainted)
if path <> expectedPath then
let expectedPath = String.Join(".", expectedPath)
let path = String.Join(".", path)
- errorR(Error(FSComp.SR.etProvidedTypeHasUnexpectedPath(expectedPath, path), m))
+ errorR(RichError(FSComp.SR.etProvidedTypeHasUnexpectedPath(RichText.mkNamespace expectedPath, RichText.mkNamespace path), m))
/// Eagerly validate a range of conditions on a provided type, after static instantiation (if any) has occurred
let ValidateProvidedTypeAfterStaticInstantiation(m, st: Tainted, expectedPath: string[], expectedName: string) =
@@ -1102,18 +1102,18 @@ let ValidateProvidedTypeAfterStaticInstantiation(m, st: Tainted, e
// This needs to be a *shallow* exploration. Otherwise, as in Freebase sample the entire database could be explored.
for mi in usedMembers do
match mi with
- | Tainted.Null -> errorR(Error(FSComp.SR.etNullMember fullName, m))
+ | Tainted.Null -> errorR(RichError(FSComp.SR.etNullMember (RichText.mkQualifiedTypeName fullName), m))
| Tainted.NonNull _ ->
let memberName = TryMemberMember(mi, fullName, "Name", "Name", m, "invalid provided type member name", fun mi -> mi.Name) |> unmarshal
if String.IsNullOrEmpty memberName then
- errorR(Error(FSComp.SR.etNullOrEmptyMemberName fullName, m))
+ errorR(RichError(FSComp.SR.etNullOrEmptyMemberName (RichText.mkQualifiedTypeName fullName), m))
else
let miDeclaringType = TryMemberMember(mi, fullName, memberName, "DeclaringType", m, (ProvidedType.CreateNoContext(typeof) |> withNull), fun mi -> mi.DeclaringType)
match miDeclaringType with
// Generated nested types may have null DeclaringType
| Tainted.Null when mi.OfType().IsSome -> ()
| Tainted.Null ->
- errorR(Error(FSComp.SR.etNullMemberDeclaringType(fullName, memberName), m))
+ errorR(RichError(FSComp.SR.etNullMemberDeclaringType(RichText.mkQualifiedTypeName fullName, RichText.mkMember memberName), m))
| Tainted.NonNull miDeclaringType ->
let miDeclaringTypeFullName =
TryMemberMember (miDeclaringType, fullName, memberName, "FullName", m,
@@ -1122,14 +1122,14 @@ let ValidateProvidedTypeAfterStaticInstantiation(m, st: Tainted, e
|> unmarshal
if not (ProvidedType.TaintedEquals (st, miDeclaringType)) then
- errorR(Error(FSComp.SR.etNullMemberDeclaringTypeDifferentFromProvidedType(fullName, memberName, miDeclaringTypeFullName), m))
+ errorR(RichError(FSComp.SR.etNullMemberDeclaringTypeDifferentFromProvidedType(RichText.mkQualifiedTypeName fullName, RichText.mkMember memberName, RichText.mkQualifiedTypeName miDeclaringTypeFullName), m))
match mi.OfType() with
| Some mi ->
let isPublic = TryMemberMember(mi, fullName, memberName, "IsPublic", m, true, fun mi->mi.IsPublic) |> unmarshal
let isGenericMethod = TryMemberMember(mi, fullName, memberName, "IsGenericMethod", m, true, fun mi->mi.IsGenericMethod) |> unmarshal
if not isPublic || isGenericMethod then
- errorR(Error(FSComp.SR.etMethodHasRequirements(fullName, memberName), m))
+ errorR(RichError(FSComp.SR.etMethodHasRequirements(RichText.mkMember memberName, RichText.mkQualifiedTypeName fullName), m))
| None ->
match mi.OfType() with
| Some subType -> ValidateAttributesOfProvidedType(m, subType)
@@ -1150,14 +1150,14 @@ let ValidateProvidedTypeAfterStaticInstantiation(m, st: Tainted, e
let canWrite = TryMemberMember(pi, fullName, memberName, "CanWrite", m, expectWrite, fun pi-> pi.CanWrite) |> unmarshal
match expectRead, canRead with
| false, false | true, true-> ()
- | false, true -> errorR(Error(FSComp.SR.etPropertyCanReadButHasNoGetter(memberName, fullName), m))
- | true, false -> errorR(Error(FSComp.SR.etPropertyHasGetterButNoCanRead(memberName, fullName), m))
+ | false, true -> errorR(RichError(FSComp.SR.etPropertyCanReadButHasNoGetter(RichText.mkMember memberName, RichText.mkQualifiedTypeName fullName), m))
+ | true, false -> errorR(RichError(FSComp.SR.etPropertyHasGetterButNoCanRead(RichText.mkMember memberName, RichText.mkQualifiedTypeName fullName), m))
match expectWrite, canWrite with
| false, false | true, true-> ()
- | false, true -> errorR(Error(FSComp.SR.etPropertyCanWriteButHasNoSetter(memberName, fullName), m))
- | true, false -> errorR(Error(FSComp.SR.etPropertyHasSetterButNoCanWrite(memberName, fullName), m))
+ | false, true -> errorR(RichError(FSComp.SR.etPropertyCanWriteButHasNoSetter(RichText.mkMember memberName, RichText.mkQualifiedTypeName fullName), m))
+ | true, false -> errorR(RichError(FSComp.SR.etPropertyHasSetterButNoCanWrite(RichText.mkMember memberName, RichText.mkQualifiedTypeName fullName), m))
if not canRead && not canWrite then
- errorR(Error(FSComp.SR.etPropertyNeedsCanWriteOrCanRead(memberName, fullName), m))
+ errorR(RichError(FSComp.SR.etPropertyNeedsCanWriteOrCanRead(RichText.mkMember memberName, RichText.mkQualifiedTypeName fullName), m))
| None ->
match mi.OfType() with
@@ -1167,8 +1167,8 @@ let ValidateProvidedTypeAfterStaticInstantiation(m, st: Tainted, e
let adder = TryMemberMember(ei, fullName, memberName, "GetAddMethod", m, null, fun ei-> ei.GetAddMethod())
let remover = TryMemberMember(ei, fullName, memberName, "GetRemoveMethod", m, null, fun ei-> ei.GetRemoveMethod())
match adder, remover with
- | Tainted.Null, _ -> errorR(Error(FSComp.SR.etEventNoAdd(memberName, fullName), m))
- | _, Tainted.Null -> errorR(Error(FSComp.SR.etEventNoRemove(memberName, fullName), m))
+ | Tainted.Null, _ -> errorR(RichError(FSComp.SR.etEventNoAdd(RichText.mkMember memberName, RichText.mkQualifiedTypeName fullName), m))
+ | _, Tainted.Null -> errorR(RichError(FSComp.SR.etEventNoRemove(RichText.mkMember memberName, RichText.mkQualifiedTypeName fullName), m))
| _, _ -> ()
| None ->
match mi.OfType() with
@@ -1177,7 +1177,7 @@ let ValidateProvidedTypeAfterStaticInstantiation(m, st: Tainted, e
match mi.OfType() with
| Some _ -> () // TODO: Fields must be public, literals must have a value etc.
| None ->
- errorR(Error(FSComp.SR.etUnsupportedMemberKind(memberName, fullName), m))
+ errorR(RichError(FSComp.SR.etUnsupportedMemberKind(RichText.mkMember memberName, RichText.mkQualifiedTypeName fullName), m))
let ValidateProvidedTypeDefinition(m, st: Tainted, expectedPath: string[], expectedName: string) =
@@ -1192,7 +1192,7 @@ let ValidateProvidedTypeDefinition(m, st: Tainted, expectedPath: s
// This excludes, for example, types with '.' in them which would not be resolvable during name resolution.
match expectedName.IndexOfAny(PrettyNaming.IllegalCharactersInTypeAndNamespaceNames) with
| -1 -> ()
- | n -> errorR(Error(FSComp.SR.etIllegalCharactersInTypeName(string expectedName[n], expectedName), m))
+ | n -> errorR(RichError(FSComp.SR.etIllegalCharactersInTypeName(RichText.mkText (string expectedName[n]), RichText.mkQualifiedTypeName expectedName), m))
let staticParameters = st.PApplyWithProvider((fun (st, provider) -> st.GetStaticParameters provider), range=m)
if staticParameters.PUntaint((fun a -> (nonNull a).Length), m) = 0 then
@@ -1283,7 +1283,7 @@ let TryApplyProvidedMethod(methBeforeArgs: Tainted, staticAr
| Tainted.NonNull methWithArguments ->
let actualName = methWithArguments.PUntaint((fun x -> x.Name), m)
if actualName <> mangledName then
- error(Error(FSComp.SR.etProvidedAppliedMethodHadWrongName(methWithArguments.TypeProviderDesignation, mangledName, actualName), m))
+ error(RichError(FSComp.SR.etProvidedAppliedMethodHadWrongName(RichText.mkText methWithArguments.TypeProviderDesignation, RichText.mkMember mangledName, RichText.mkMember actualName), m))
Some methWithArguments
@@ -1312,7 +1312,7 @@ let TryApplyProvidedType(typeBeforeArguments: Tainted, optGenerate
let checkTypeName() =
let expectedTypeNameAfterArguments = fullTypePathAfterArguments[fullTypePathAfterArguments.Length-1]
if actualName <> expectedTypeNameAfterArguments then
- error(Error(FSComp.SR.etProvidedAppliedTypeHadWrongName(typeWithArguments.TypeProviderDesignation, expectedTypeNameAfterArguments, actualName), m))
+ error(RichError(FSComp.SR.etProvidedAppliedTypeHadWrongName(RichText.mkText typeWithArguments.TypeProviderDesignation, RichText.mkQualifiedTypeName expectedTypeNameAfterArguments, RichText.mkQualifiedTypeName actualName), m))
Some (typeWithArguments, checkTypeName)
/// Given a mangled name reference to a non-nested provided type, resolve it.
@@ -1324,7 +1324,7 @@ let TryLinkProvidedType(resolver: Tainted, moduleOrNamespace: str
try
PrettyNaming.DemangleProvidedTypeName typeLogicalName
with PrettyNaming.InvalidMangledStaticArg piece ->
- error(Error(FSComp.SR.etProvidedTypeReferenceInvalidText piece, range0))
+ error(RichError(FSComp.SR.etProvidedTypeReferenceInvalidText (RichText.mkText piece), range0))
let argSpecsTable = dict argNamesAndValues
let typeBeforeArguments = ResolveProvidedType(resolver, range0, moduleOrNamespace, typeName)
@@ -1368,15 +1368,15 @@ let TryLinkProvidedType(resolver: Tainted, moduleOrNamespace: str
| "System.Char" -> box (char arg)
| "System.Boolean" -> box (arg = "True")
| "System.String" -> box (string arg)
- | s -> error(Error(FSComp.SR.etUnknownStaticArgumentKind(s, typeLogicalName), range0))
+ | s -> error(RichError(FSComp.SR.etUnknownStaticArgumentKind(RichText.mkText s, RichText.mkQualifiedTypeName typeLogicalName), range0))
| _ ->
if sp.PUntaint ((fun sp -> sp.IsOptional), range) then
match sp.PUntaint((fun sp -> sp.RawDefaultValue), range) with
- | null -> error (Error(FSComp.SR.etStaticParameterRequiresAValue (spName, typeBeforeArgumentsName, typeBeforeArgumentsName, spName), range0))
+ | null -> error (RichError(FSComp.SR.etStaticParameterRequiresAValue (RichText.mkParameter spName, RichText.mkQualifiedTypeName typeBeforeArgumentsName, RichText.mkQualifiedTypeName typeBeforeArgumentsName, RichText.mkParameter spName), range0))
| v -> v
else
- error(Error(FSComp.SR.etProvidedTypeReferenceMissingArgument spName, range0)))
+ error(RichError(FSComp.SR.etProvidedTypeReferenceMissingArgument (RichText.mkParameter spName), range0)))
match TryApplyProvidedType(typeBeforeArguments, None, staticArgs, range0) with
@@ -1399,7 +1399,7 @@ let GetProvidedNamespaceAsPath (m, resolver: Tainted, namespaceNa
| Null -> []
| NonNull namespaceName ->
if namespaceName.Length = 0 then
- errorR(Error(FSComp.SR.etEmptyNamespaceNotAllowed(DisplayNameOfTypeProvider(resolver.TypeProvider, m)), m))
+ errorR(RichError(FSComp.SR.etEmptyNamespaceNotAllowed(RichText.mkText (DisplayNameOfTypeProvider(resolver.TypeProvider, m))), m))
GetPartsOfNamespaceRecover namespaceName
/// Get the parts of the name that encloses the .NET type including nested types.
diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs
index 1686f36aa28..1dc0a7d1c35 100644
--- a/src/Compiler/TypedTree/TypedTree.fs
+++ b/src/Compiler/TypedTree/TypedTree.fs
@@ -508,7 +508,7 @@ type EntityFlags(flags: int64) =
exception UndefinedName of
depth: int *
- error: (string -> string) *
+ error: (RichText -> RichText) *
id: Ident *
suggestions: Suggestions
@@ -1001,7 +1001,9 @@ type Entity =
member x.CompilationPath =
match x.CompilationPathOpt with
| Some cpath -> cpath
- | None -> error(Error(FSComp.SR.tastTypeOrModuleNotConcrete(x.LogicalName), x.Range))
+ | None ->
+ let tag = if x.IsModuleOrNamespace then TextTag.Module else TextTag.Class
+ error(RichError(FSComp.SR.tastTypeOrModuleNotConcrete(RichText.ofTag tag x.LogicalName), x.Range))
/// Get a table of fields for all the F#-defined record, struct and class fields in this type definition, including
/// static fields, 'val' declarations and hidden fields from the compilation of implicit class constructions.
diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi
index 25149889328..ed06d036408 100644
--- a/src/Compiler/TypedTree/TypedTree.fsi
+++ b/src/Compiler/TypedTree/TypedTree.fsi
@@ -315,7 +315,7 @@ type EntityFlags =
/// This bit is reserved for us in the pickle format, see pickle.fs, it's being listed here to stop it ever being used for anything else
static member ReservedBitForPickleFormatTyconReprFlag: int64
-exception UndefinedName of depth: int * error: (string -> string) * id: Ident * suggestions: Suggestions
+exception UndefinedName of depth: int * error: (RichText -> RichText) * id: Ident * suggestions: Suggestions
exception InternalUndefinedItemRef of (string * string * string -> int * string) * string * string * string
diff --git a/src/Compiler/TypedTree/TypedTreeOps.ExprOps.fs b/src/Compiler/TypedTree/TypedTreeOps.ExprOps.fs
index 91ed02ee1a3..9706abd4d14 100644
--- a/src/Compiler/TypedTree/TypedTreeOps.ExprOps.fs
+++ b/src/Compiler/TypedTree/TypedTreeOps.ExprOps.fs
@@ -457,7 +457,14 @@ module internal ExprFolding =
not (c.FieldByIndex n).IsMutable
&& not (entityRefInThisAssembly g.compilingFSharpCore tcref)
then
- errorR (Error(FSComp.SR.tastRecursiveValuesMayNotAppearInConstructionOfType (tcref.LogicalName), m))
+ errorR (
+ RichError(
+ FSComp.SR.tastRecursiveValuesMayNotAppearInConstructionOfType (
+ richTextOfEntityRefName tcref tcref.LogicalName
+ ),
+ m
+ )
+ )
mkUnionCaseFieldSet (access, c, tinst, n, e, m))))
@@ -475,10 +482,10 @@ module internal ExprFolding =
// NICE: it would be better to do this check in the type checker
if not fspec.IsMutable && not (entityRefInThisAssembly g.compilingFSharpCore tcref) then
errorR (
- Error(
+ RichError(
FSComp.SR.tastRecursiveValuesMayNotBeAssignedToNonMutableField (
- fspec.rfield_id.idText,
- tcref.LogicalName
+ RichText.mkField fspec.rfield_id.idText,
+ richTextOfEntityRefName tcref tcref.LogicalName
),
m
)
diff --git a/src/Compiler/TypedTree/TypedTreeOps.FreeVars.fs b/src/Compiler/TypedTree/TypedTreeOps.FreeVars.fs
index 80f6bee3b5b..9606877a495 100644
--- a/src/Compiler/TypedTree/TypedTreeOps.FreeVars.fs
+++ b/src/Compiler/TypedTree/TypedTreeOps.FreeVars.fs
@@ -1381,6 +1381,41 @@ module internal MemberRepresentation =
else
tagClass name
+ let richTextOfEntityRefName xref name =
+ RichText.ofTaggedText (tagEntityRefName xref name)
+
+ let richTextOfEntityName (entity: Entity) name =
+ richTextOfEntityRefName (mkLocalEntityRef entity) name
+
+ let richTextOfEntityRef (xref: EntityRef) =
+ richTextOfEntityRefName xref xref.DisplayName
+
+ let richTextOfEntity (entity: Entity) =
+ richTextOfEntityName entity entity.DisplayName
+
+ let tagValName g (v: Val) name =
+ let isDiscard (name: string) = name.StartsWithOrdinal "_"
+
+ if v.IsMember then
+ if (arityOfVal v).HasNoArgs then
+ tagMember name
+ else
+ tagMethod name
+ elif isForallFunctionTy g v.Type && not (isDiscard v.DisplayNameCore) then
+ if IsOperatorDisplayName v.DisplayName then
+ tagOperator name
+ else
+ tagFunction name
+ elif not v.IsCompiledAsTopLevel && not (isDiscard v.DisplayNameCore) then
+ tagLocal name
+ elif v.IsModuleBinding then
+ tagModuleBinding name
+ else
+ tagUnknownEntity name
+
+ let richTextOfValName g (v: Val) =
+ RichText.ofTaggedText (tagValName g v v.DisplayName)
+
let fullDisplayTextOfTyconRef (tcref: TyconRef) =
fullNameOfEntityRef (fun tcref -> tcref.DisplayNameWithStaticParametersAndUnderscoreTypars) tcref
@@ -1416,6 +1451,9 @@ module internal MemberRepresentation =
let fullDisplayTextOfModRef r =
fullNameOfEntityRef (fun eref -> eref.DemangledModuleOrNamespaceName) r
+ let fullDisplayTextOfModRefAsLayout r =
+ fullNameOfEntityRefAsLayout (fun eref -> eref.DemangledModuleOrNamespaceName) r
+
let fullDisplayTextOfTyconRefAsLayout tcref =
fullNameOfEntityRefAsLayout (fun tcref -> tcref.DisplayNameWithStaticParametersAndUnderscoreTypars) tcref
@@ -1473,6 +1511,20 @@ module internal MemberRepresentation =
| ValueSome pathText -> pathText ^^ SepL.dot ^^ wordL n
//pathText +.+ vref.DisplayName
+ // A qualified name is classified one component at a time: each name by what it names and each dot
+ // as punctuation. Splicing the flattened text into a message instead would classify the dots, and
+ // every component, as whatever the last component happens to be.
+ let richTextOfPath p = toRichText (layoutOfPath p)
+
+ let richTextOfQualifiedModRef r =
+ toRichText (fullDisplayTextOfModRefAsLayout r)
+
+ let richTextOfQualifiedTyconRef tcref =
+ toRichText (fullDisplayTextOfTyconRefAsLayout tcref)
+
+ let richTextOfQualifiedValRef vref =
+ toRichText (fullDisplayTextOfValRefAsLayout vref)
+
let fullMangledPathToTyconRef (tcref: TyconRef) =
match tcref with
| ERefLocal _ ->
diff --git a/src/Compiler/TypedTree/TypedTreeOps.FreeVars.fsi b/src/Compiler/TypedTree/TypedTreeOps.FreeVars.fsi
index 5024964297e..0e9761fe5ea 100644
--- a/src/Compiler/TypedTree/TypedTreeOps.FreeVars.fsi
+++ b/src/Compiler/TypedTree/TypedTreeOps.FreeVars.fsi
@@ -310,6 +310,27 @@ module internal MemberRepresentation =
val tagEntityRefName: xref: EntityRef -> name: string -> TaggedText
+ /// A name of an entity as rich text, classified by the kind of entity it names. Use this only when
+ /// the name is not the entity's display name, e.g. its compiled or fully qualified one.
+ val richTextOfEntityRefName: xref: EntityRef -> name: string -> RichText
+
+ /// A name of an entity as rich text, classified by the kind of entity it names. Use this only when
+ /// the name is not the entity's display name.
+ val richTextOfEntityName: entity: Entity -> name: string -> RichText
+
+ /// The display name of an entity as rich text, classified by the kind of entity it is
+ val richTextOfEntityRef: xref: EntityRef -> RichText
+
+ /// The display name of an entity as rich text, classified by the kind of entity it is
+ val richTextOfEntity: entity: Entity -> RichText
+
+ /// The tag for the name of a value, by what kind of value it is. This is the choice the signature
+ /// printer makes, so that a name in a message reads the way it does in a signature.
+ val tagValName: g: TcGlobals -> v: Val -> name: string -> TaggedText
+
+ /// The display name of a value as rich text, classified by what kind of value it is
+ val richTextOfValName: g: TcGlobals -> v: Val -> RichText
+
/// Return the full text for an item as we want it displayed to the user as a fully qualified entity
val fullDisplayTextOfModRef: ModuleOrNamespaceRef -> string
@@ -323,6 +344,19 @@ module internal MemberRepresentation =
val fullDisplayTextOfTyconRefAsLayout: TyconRef -> Layout
+ /// A dotted path as rich text, classifying each component and each dot separately
+ val richTextOfPath: string list -> RichText
+
+ /// The fully qualified name of a module or namespace, classifying each component and each dot
+ /// separately, so that a dot never reads as part of a name
+ val richTextOfQualifiedModRef: ModuleOrNamespaceRef -> RichText
+
+ /// The fully qualified name of a type, classifying each component and each dot separately
+ val richTextOfQualifiedTyconRef: TyconRef -> RichText
+
+ /// The fully qualified name of a value, classifying each component and each dot separately
+ val richTextOfQualifiedValRef: ValRef -> RichText
+
val fullDisplayTextOfExnRef: TyconRef -> string
val fullDisplayTextOfExnRefAsLayout: TyconRef -> Layout
diff --git a/src/Compiler/TypedTree/TypedTreeOps.Remapping.fs b/src/Compiler/TypedTree/TypedTreeOps.Remapping.fs
index 27522bcc7af..36787b74c60 100644
--- a/src/Compiler/TypedTree/TypedTreeOps.Remapping.fs
+++ b/src/Compiler/TypedTree/TypedTreeOps.Remapping.fs
@@ -623,16 +623,40 @@ module internal SignatureOps =
match entity1.IsNamespace, entity2.IsNamespace, entity1.IsModule, entity2.IsModule with
| true, true, _, _ -> ()
| true, _, _, true
- | _, true, true, _ -> errorR (Error(FSComp.SR.tastNamespaceAndModuleWithSameNameInAssembly (textOfPath path2), entity2.Range))
+ | _, true, true, _ ->
+ errorR (RichError(FSComp.SR.tastNamespaceAndModuleWithSameNameInAssembly (richTextOfPath path2), entity2.Range))
| true, _, _, _
| _, true, _, _ ->
- errorR (Error(FSComp.SR.tastNamespaceAndTypeWithSameNameInAssembly (textOfPath path2, entity2.LogicalName), entity2.Range))
+ errorR (
+ RichError(
+ FSComp.SR.tastNamespaceAndTypeWithSameNameInAssembly (
+ richTextOfPath path2,
+ richTextOfEntityName entity2 entity2.LogicalName
+ ),
+ entity2.Range
+ )
+ )
| false, false, false, false ->
- errorR (Error(FSComp.SR.tastDuplicateTypeDefinitionInAssembly (entity2.LogicalName, textOfPath path), entity2.Range))
- | false, false, true, true -> errorR (Error(FSComp.SR.tastTwoModulesWithSameNameInAssembly (textOfPath path2), entity2.Range))
+ errorR (
+ RichError(
+ FSComp.SR.tastDuplicateTypeDefinitionInAssembly (
+ richTextOfEntityName entity2 entity2.LogicalName,
+ richTextOfPath path
+ ),
+ entity2.Range
+ )
+ )
+ | false, false, true, true ->
+ errorR (RichError(FSComp.SR.tastTwoModulesWithSameNameInAssembly (richTextOfPath path2), entity2.Range))
| _ ->
errorR (
- Error(FSComp.SR.tastConflictingModuleAndTypeDefinitionInAssembly (entity2.LogicalName, textOfPath path), entity2.Range)
+ RichError(
+ FSComp.SR.tastConflictingModuleAndTypeDefinitionInAssembly (
+ richTextOfEntityName entity2 entity2.LogicalName,
+ richTextOfPath path
+ ),
+ entity2.Range
+ )
)
entity1
diff --git a/src/Compiler/TypedTree/TypedTreeOps.Transforms.fs b/src/Compiler/TypedTree/TypedTreeOps.Transforms.fs
index 4b4f4ccee29..491096d0e26 100644
--- a/src/Compiler/TypedTree/TypedTreeOps.Transforms.fs
+++ b/src/Compiler/TypedTree/TypedTreeOps.Transforms.fs
@@ -312,7 +312,7 @@ module internal XmlDocSignatures =
let vtps = v.Typars |> Zset.ofList typarOrder
if not (isFunTy g v.TauType) then
- errorR (Error(FSComp.SR.activePatternIdentIsNotFunctionTyped (v.LogicalName), v.Range))
+ errorR (RichError(FSComp.SR.activePatternIdentIsNotFunctionTyped (RichText.mkActivePatternCase v.LogicalName), v.Range))
let argTys, resty = stripFunTy g vty
diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs
index 4fe8eaf121f..65ef38ef1b1 100644
--- a/src/Compiler/TypedTree/TypedTreePickle.fs
+++ b/src/Compiler/TypedTree/TypedTreePickle.fs
@@ -33,7 +33,7 @@ open FSharp.Compiler.TcGlobals
let verbose = false
#endif
-let ffailwith fileName str =
+let ffailwith (fileName: string) (str: string) =
let msg = FSComp.SR.pickleErrorReadingWritingMetadata (fileName, str)
System.Diagnostics.Debug.Assert(false, msg)
failwith msg
diff --git a/src/Compiler/TypedTree/tainted.fs b/src/Compiler/TypedTree/tainted.fs
index 1017d62ef62..1d826bde0f7 100644
--- a/src/Compiler/TypedTree/tainted.fs
+++ b/src/Compiler/TypedTree/tainted.fs
@@ -23,33 +23,39 @@ type internal TypeProviderError
errNum: int,
tpDesignation: string,
m: range,
- errors: string list,
+ errors: RichText list,
typeNameContext: string option,
methodNameContext: string option
) =
inherit Exception()
- new((errNum, msg: string), tpDesignation,m) =
+ new((errNum, msg: RichText), tpDesignation,m) =
TypeProviderError(errNum, tpDesignation, m, [msg])
+
+ /// For a message with nothing in it to classify, as Error is to RichError
+ new((errNum, msg: string), tpDesignation, m) =
+ TypeProviderError((errNum, RichText.mkText msg), tpDesignation, m)
- new(errNum, tpDesignation, m, messages: seq) =
+ new(errNum, tpDesignation, m, messages: seq) =
TypeProviderError(errNum, tpDesignation, m, List.ofSeq messages, None, None)
member _.Number = errNum
member _.Range = m
- override _.Message =
+ member _.RichMessage =
match errors with
| [text] -> text
| inner ->
// imitates old-fashioned behavior with merged text
// usually should not fall into this case (only if someone takes Message directly instead of using Iter)
inner
- |> String.concat Environment.NewLine
+ |> RichText.concatWith (RichText.mkText Environment.NewLine)
+
+ override this.Message = this.RichMessage.Text
member _.MapText(f, tpDesignation, m) =
- let (errNum: int), _ = f ""
+ let (errNum: int), _ = f RichText.empty
TypeProviderError(errNum, tpDesignation, m, (Seq.map (f >> snd) errors))
member _.WithContext(typeNameContext:string, methodNameContext:string) =
@@ -60,14 +66,21 @@ type internal TypeProviderError
// TPE having type\method name as contextual information
// without context: Type Provider 'TP' has reported the error: MSG
// with context: Type Provider 'TP' has reported the error in method M of type T: MSG
- member this.ContextualErrorMessage=
+ member this.ContextualErrorRichMessage =
match typeNameContext, methodNameContext with
| Some tc, Some mc ->
- let _,msgWithPrefix = FSComp.SR.etProviderErrorWithContext(tpDesignation, tc, mc, this.Message)
+ let _,msgWithPrefix =
+ FSComp.SR.etProviderErrorWithContext(
+ RichText.mkText tpDesignation,
+ RichText.mkQualifiedTypeName tc,
+ RichText.mkMethod mc,
+ this.RichMessage)
msgWithPrefix
| _ ->
- let _,msgWithPrefix = FSComp.SR.etProviderError(tpDesignation, this.Message)
+ let _,msgWithPrefix = FSComp.SR.etProviderError(RichText.mkText tpDesignation, this.RichMessage)
msgWithPrefix
+
+ member this.ContextualErrorMessage = this.ContextualErrorRichMessage.Text
/// provides uniform way to handle plain and composite instances of TypeProviderError
member this.Iter f =
@@ -101,11 +114,11 @@ type internal Tainted<'T> (context: TaintedContext, value: 'T) =
| :? TypeProviderError -> reraise()
| :? AggregateException as ae ->
let errNum,_ = FSComp.SR.etProviderError("", "")
- let messages = [for e in ae.InnerExceptions -> if isNull e.InnerException then e.Message else (e.Message + ": " + e.GetBaseException().Message)]
+ let messages = [for e in ae.InnerExceptions -> RichText.mkText (if isNull e.InnerException then e.Message else (e.Message + ": " + e.GetBaseException().Message))]
raise <| TypeProviderError(errNum, this.TypeProviderDesignation, range, messages)
| e ->
let errNum,_ = FSComp.SR.etProviderError("", "")
- let error = if isNull e.InnerException then e.Message else (e.Message + ": " + e.GetBaseException().Message)
+ let error = RichText.mkText (if isNull e.InnerException then e.Message else (e.Message + ": " + e.GetBaseException().Message))
raise <| TypeProviderError((errNum, error), this.TypeProviderDesignation, range)
member _.TypeProvider = Tainted<_>(context, context.TypeProvider)
@@ -132,16 +145,16 @@ type internal Tainted<'T> (context: TaintedContext, value: 'T) =
let u = this.Protect (fun x -> f (x, context.TypeProvider)) range
Tainted(context, u)
- member this.PApplyArray(f, methodName, range:range) =
+ member this.PApplyArray(f, methodName: string, range:range) =
let a : 'U[] | null = this.Protect f range
match a with
- | Null -> raise <| TypeProviderError(FSComp.SR.etProviderReturnedNull(methodName), this.TypeProviderDesignation, range)
+ | Null -> raise <| TypeProviderError(FSComp.SR.etProviderReturnedNull(RichText.mkMethod methodName), this.TypeProviderDesignation, range)
| NonNull a -> a |> Array.map (fun u -> Tainted(context,u))
- member this.PApplyFilteredArray(factory, filter, methodName, range:range) =
+ member this.PApplyFilteredArray(factory, filter, methodName: string, range:range) =
let a : 'U[] | null = this.Protect factory range
match a with
- | Null -> raise <| TypeProviderError(FSComp.SR.etProviderReturnedNull(methodName), this.TypeProviderDesignation, range)
+ | Null -> raise <| TypeProviderError(FSComp.SR.etProviderReturnedNull(RichText.mkMethod methodName), this.TypeProviderDesignation, range)
| NonNull a -> a |> Array.filter filter |> Array.map (fun u -> Tainted(context,u))
member this.PApplyOption(f, range: range) =
diff --git a/src/Compiler/TypedTree/tainted.fsi b/src/Compiler/TypedTree/tainted.fsi
index 2d3e5baa465..f27b9fdd02f 100644
--- a/src/Compiler/TypedTree/tainted.fsi
+++ b/src/Compiler/TypedTree/tainted.fsi
@@ -22,22 +22,30 @@ type internal TypeProviderError =
inherit System.Exception
/// creates new instance of TypeProviderError that represents one error
+ new: (int * RichText) * string * range -> TypeProviderError
+
+ /// creates new instance of TypeProviderError from a message with nothing in it to classify
new: (int * string) * string * range -> TypeProviderError
/// creates new instance of TypeProviderError that represents collection of errors
- new: int * string * range * seq -> TypeProviderError
+ new: int * string * range * seq -> TypeProviderError
member Number: int
member Range: range
+ /// The message of this error, with the classification of its parts
+ member RichMessage: RichText
+
+ member ContextualErrorRichMessage: RichText
+
member ContextualErrorMessage: string
/// creates new instance of TypeProviderError with specified type\method names
member WithContext: string * string -> TypeProviderError
/// creates new instance of TypeProviderError based on current instance information(message)
- member MapText: (string -> int * string) * string * range -> TypeProviderError
+ member MapText: (RichText -> int * RichText) * string * range -> TypeProviderError
/// provides uniform way to process aggregated errors
member Iter: (TypeProviderError -> unit) -> unit
diff --git a/src/Compiler/Utilities/sformat.fs b/src/Compiler/Utilities/sformat.fs
index 174094b800a..e97978f4615 100644
--- a/src/Compiler/Utilities/sformat.fs
+++ b/src/Compiler/Utilities/sformat.fs
@@ -72,6 +72,7 @@ type TextTag =
| Punctuation
| UnknownType
| UnknownEntity
+ | UnresolvedName
type TaggedText(tag: TextTag, text: string) =
member x.Tag = tag
@@ -213,6 +214,7 @@ module TaggedText =
let tagUnion t = mkTag TextTag.Union t
let tagMember t = mkTag TextTag.Member t
let tagUnknownEntity t = mkTag TextTag.UnknownEntity t
+ let tagUnresolvedName t = mkTag TextTag.UnresolvedName t
let tagUnknownType t = mkTag TextTag.UnknownType t
// common tagged literals
diff --git a/src/Compiler/Utilities/sformat.fsi b/src/Compiler/Utilities/sformat.fsi
index 224452b7ee4..6a652b5fb02 100644
--- a/src/Compiler/Utilities/sformat.fsi
+++ b/src/Compiler/Utilities/sformat.fsi
@@ -69,6 +69,7 @@ type TextTag =
| Punctuation
| UnknownType
| UnknownEntity
+ | UnresolvedName
/// Represents text with a tag
type public TaggedText =
@@ -159,6 +160,7 @@ module internal TaggedText =
val internal tagUnion: string -> TaggedText
val internal tagMember: string -> TaggedText
val internal tagUnknownEntity: string -> TaggedText
+ val internal tagUnresolvedName: string -> TaggedText
val internal tagUnknownType: string -> TaggedText
val internal leftAngle: TaggedText
diff --git a/src/Compiler/lex.fsl b/src/Compiler/lex.fsl
index ce4dd5955a6..2a04e149305 100644
--- a/src/Compiler/lex.fsl
+++ b/src/Compiler/lex.fsl
@@ -109,13 +109,13 @@ let lexemeTrimRightToInt32 args lexbuf n =
let checkExprOp (lexbuf:UnicodeLexing.Lexbuf) =
if lexbuf.LexemeContains ':' then
- deprecatedWithError (FSComp.SR.lexCharNotAllowedInOperatorNames(":")) lexbuf.LexemeRange
+ deprecatedWithError (FSComp.SR.lexCharNotAllowedInOperatorNames(RichText.mkOperator ":")) lexbuf.LexemeRange
if lexbuf.LexemeContains '$' then
- deprecatedWithError (FSComp.SR.lexCharNotAllowedInOperatorNames("$")) lexbuf.LexemeRange
+ deprecatedWithError (FSComp.SR.lexCharNotAllowedInOperatorNames(RichText.mkOperator "$")) lexbuf.LexemeRange
let checkExprGreaterColonOp (lexbuf:UnicodeLexing.Lexbuf) =
if lexbuf.LexemeContains '$' then
- deprecatedWithError (FSComp.SR.lexCharNotAllowedInOperatorNames("$")) lexbuf.LexemeRange
+ deprecatedWithError (FSComp.SR.lexCharNotAllowedInOperatorNames(RichText.mkOperator "$")) lexbuf.LexemeRange
let unexpectedChar lexbuf =
LEX_FAILURE (FSComp.SR.lexUnexpectedChar(lexeme lexbuf))
diff --git a/src/Compiler/pars.fsy b/src/Compiler/pars.fsy
index 01120123a36..227c7075629 100644
--- a/src/Compiler/pars.fsy
+++ b/src/Compiler/pars.fsy
@@ -747,7 +747,7 @@ valSpfn:
{ if Option.isSome $2 then errorR(Error(FSComp.SR.parsVisibilityDeclarationsShouldComePriorToIdentifier(), rhs parseState 2))
let attr1, attr2, isInline, isMutable, vis2, id, doc, explicitValTyparDecls, (ty, arity), (mEquals, konst: SynExpr option) = ($1), ($4), (Option.isSome $5), (Option.isSome $6), ($7), ($8), grabXmlDoc(parseState, $1, 1), ($9), ($11), ($12)
let vis2 = SynValSigAccess.Single(vis2)
- if not (isNil attr2) then errorR(Deprecated(FSComp.SR.parsAttributesMustComeBeforeVal(), rhs parseState 4))
+ if not (isNil attr2) then errorR(Deprecated(RichText.mkText (FSComp.SR.parsAttributesMustComeBeforeVal()), rhs parseState 4))
let m =
rhs2 parseState 1 11
|> unionRangeWithXmlDoc doc
@@ -2950,7 +2950,7 @@ unionCaseReprElement:
unionCaseRepr:
| braceFieldDeclList
- { errorR(Deprecated(FSComp.SR.parsConsiderUsingSeparateRecordType(), lhs parseState))
+ { errorR(Deprecated(RichText.mkText (FSComp.SR.parsConsiderUsingSeparateRecordType()), lhs parseState))
$1, rhs parseState 1 }
| unionCaseReprElements
@@ -5460,7 +5460,7 @@ atomicExprQualification:
| SynExpr.IndexRange(None, mOperator, None, _m1, _m2, _) ->
mkSynDot mDot mLhs e (SynIdent(ident(CompileOpName "*", mOperator), Some(IdentTrivia.OriginalNotationWithParen(lpr, "*", rpr))))
| _ ->
- errorR(Deprecated(FSComp.SR.astDeprecatedIndexerNotation(), lhs parseState))
+ errorR(Deprecated(RichText.mkText (FSComp.SR.astDeprecatedIndexerNotation()), lhs parseState))
exprFromParseError $2) }
| LBRACK typedSequentialExpr RBRACK
@@ -7107,7 +7107,7 @@ opt_ODECLEND:
| /* EMPTY */ { }
deprecated_opt_equals:
- | EQUALS { deprecatedWithError (FSComp.SR.parsNoEqualShouldFollowNamespace()) (lhs parseState); () }
+ | EQUALS { deprecatedWithError (RichText.mkText (FSComp.SR.parsNoEqualShouldFollowNamespace())) (lhs parseState); () }
| /* EMPTY */ { }
opt_OBLOCKSEP:
diff --git a/src/FSharp.Build/FSharpEmbedResourceText.fs b/src/FSharp.Build/FSharpEmbedResourceText.fs
index a1f5f56dba3..ba868f942c7 100644
--- a/src/FSharp.Build/FSharpEmbedResourceText.fs
+++ b/src/FSharp.Build/FSharpEmbedResourceText.fs
@@ -393,10 +393,21 @@ open Printf
static member SwallowResourceText: bool with get, set
// END BOILERPLATE"
- let generateResxAndSource (fileName: string) =
+ /// Marks a generated file as having the overloads taking classified text, and brings RichText into
+ /// scope for them
+ let richTextOpen = "open FSharp.Compiler.Text"
+
+ let generateResxAndSource (item: ITaskItem) =
+ let fileName = item.ItemSpec
+
try
let printMessage fmt = Printf.ksprintf this.Log.LogMessage fmt
+ // Opt in with true on the EmbeddedText item. Only assemblies that can
+ // see FSharp.Compiler.Text.RichText are able to compile the classified overloads.
+ let richText =
+ System.String.Equals(item.GetMetadata "RichText", "true", System.StringComparison.OrdinalIgnoreCase)
+
let justFileName = Path.GetFileNameWithoutExtension(fileName) // .txt
if justFileName |> Seq.exists (System.Char.IsLetterOrDigit >> not) then
@@ -424,7 +435,14 @@ open Printf
condition4
&& (File.GetLastWriteTimeUtc(fileName) <= File.GetLastWriteTimeUtc(outXmlFileName))
- if condition5 then
+ // A generated file does not record whether it was generated with RichText, so the flag has
+ // to be recovered from the open the generator emits for it, or an existing file would be
+ // taken as up-to-date after the flag changed
+ let condition6 =
+ condition5
+ && (richText = (File.ReadLines(outFileName) |> Seq.truncate 40 |> Seq.contains richTextOpen))
+
+ if condition6 then
printMessage "Skipping generation of %s and %s from %s since up-to-date" outFileName outXmlFileName fileName
Some(fileName, outFileSignatureName, outFileName, outXmlFileName)
@@ -438,7 +456,8 @@ open Printf
elif not condition2 then 2
elif not condition3 then 3
elif not condition4 then 4
- else 5)
+ elif not condition5 then 5
+ else 6)
printMessage "Reading %s" fileName
@@ -499,6 +518,11 @@ open Printf
fprintfn outSignature "namespace %s" justFileName
fprintfn out "%s" stringBoilerPlatePrefix
fprintfn outSignature "%s" stringBoilerPlatePrefix
+
+ if richText then
+ fprintfn out "%s" richTextOpen
+ fprintfn outSignature "%s" richTextOpen
+
fprintfn out "type internal SR private() ="
fprintfn outSignature "type internal SR ="
fprintfn outSignature " private new: unit -> SR"
@@ -576,7 +600,59 @@ open Printf
|> String.concat " * "
|> fun parameters -> sprintf " static member %s: %s -> %s" ident parameters returnType
- fprintfn outSignature "%s" signatureMember)
+ fprintfn outSignature "%s" signatureMember
+
+ // An overload taking the string holes as classified text, so that callers can keep
+ // the classification of types and names they splice into the message. The string
+ // overload is called with a sentinel per hole, which RichMessage then replaces with
+ // the parts it stands for - see the RichMessage module.
+ if richText && holes |> Array.contains "System.String" then
+ let richHole holeType =
+ if holeType = "System.String" then
+ "RichText"
+ else
+ holeType
+
+ let richFormalArgs =
+ holes
+ |> Array.mapi (fun idx holeType -> sprintf "a%d : %s" idx (richHole holeType))
+ |> String.concat ", "
+
+ let richActualArgs =
+ holes
+ |> Array.mapi (fun idx holeType ->
+ if holeType = "System.String" then
+ sprintf "rich a%d" idx
+ else
+ sprintf "a%d" idx)
+ |> String.concat ", "
+
+ let format, richReturnType =
+ match optErrNum with
+ | None -> "text", "RichText"
+ | Some _ -> "numbered", "int * RichText"
+
+ fprintfn out " /// %s" str
+ fprintfn out " /// (Originally from %s:%d)" fileName (lineNum + 1)
+
+ fprintfn
+ out
+ " static member %s(%s) = RichMessage.%s (fun rich -> SR.%s(%s))"
+ ident
+ richFormalArgs
+ format
+ ident
+ richActualArgs
+
+ let richParameters =
+ holes
+ |> Array.mapi (fun idx holeType -> sprintf "a%i: %s" idx (richHole holeType))
+ |> String.concat " * "
+
+ fprintfn outSignature " /// %s" str
+ fprintfn outSignature " /// (Originally from %s:%d)" fileName (lineNum + 1)
+
+ fprintfn outSignature " static member %s: %s -> %s" ident richParameters richReturnType)
printMessage "Generating .resx for %s" outFileName
fprintfn out ""
@@ -632,9 +708,7 @@ open Printf
override this.Execute() =
try
- let generatedFiles =
- this.EmbeddedText
- |> Array.choose (fun item -> generateResxAndSource item.ItemSpec)
+ let generatedFiles = this.EmbeddedText |> Array.choose generateResxAndSource
let generatedSource, generatedResx =
[|
diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/LexicalAnalysis/ByteStrings.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/LexicalAnalysis/ByteStrings.fs
index b3469959680..46fb1b9e4d8 100644
--- a/tests/FSharp.Compiler.ComponentTests/Conformance/LexicalAnalysis/ByteStrings.fs
+++ b/tests/FSharp.Compiler.ComponentTests/Conformance/LexicalAnalysis/ByteStrings.fs
@@ -4,7 +4,7 @@ open Xunit
open FSharp.Test.Compiler
/// `'%s' is not a valid character literal.` with note about wrapped value and error soon
-let private invalidCharWarningMsg value wrapped =
+let private invalidCharWarningMsg (value: string) (wrapped: string) =
FSComp.SR.lexInvalidCharLiteralInString (value, wrapped)
|> snd
diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/LexicalAnalysis/Strings.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/LexicalAnalysis/Strings.fs
index 28922805ca3..051a0acdb5a 100644
--- a/tests/FSharp.Compiler.ComponentTests/Conformance/LexicalAnalysis/Strings.fs
+++ b/tests/FSharp.Compiler.ComponentTests/Conformance/LexicalAnalysis/Strings.fs
@@ -4,7 +4,7 @@ open Xunit
open FSharp.Test.Compiler
/// `'%s' is not a valid character literal.` with note about wrapped value and error soon
-let private invalidCharWarningMsg value wrapped =
+let private invalidCharWarningMsg (value: string) (wrapped: string) =
FSComp.SR.lexInvalidCharLiteralInString (value, wrapped)
|> snd
diff --git a/tests/FSharp.Compiler.ComponentTests/Diagnostics/RichDiagnosticTests.fs b/tests/FSharp.Compiler.ComponentTests/Diagnostics/RichDiagnosticTests.fs
new file mode 100644
index 00000000000..860d3877792
--- /dev/null
+++ b/tests/FSharp.Compiler.ComponentTests/Diagnostics/RichDiagnosticTests.fs
@@ -0,0 +1,184 @@
+// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
+
+namespace Diagnostics
+
+open Xunit
+open FSharp.Test
+open FSharp.Test.Assert
+open FSharp.Compiler.Text
+
+/// Checks the classification of diagnostic messages that were converted to rich text.
+/// See docs/rich-diagnostics.md.
+module RichDiagnosticTests =
+
+ let private singleDiagnostic source =
+ match CompilerAssert.TypeCheckWithOptions [||] source with
+ | [| diagnostic |] -> diagnostic
+ | diagnostics -> failwith $"Expected a single diagnostic, got:\n%A{diagnostics}"
+
+ let private diagnostic number source =
+ let diagnostics = CompilerAssert.TypeCheckWithOptions [||] source
+
+ match diagnostics |> Array.tryFind (fun d -> d.ErrorNumber = number) with
+ | Some diagnostic -> diagnostic
+ | None -> failwith $"Expected a diagnostic FS%04d{number}, got:\n%A{diagnostics}"
+
+ let private assertMessageParts expected source =
+ (singleDiagnostic source).RichMessage |> assertRichTextParts expected
+
+ let private assertMessagePartsOf number expected source =
+ (diagnostic number source).RichMessage |> assertRichTextParts expected
+
+ []
+ let ``Undefined value name is classified`` () =
+ "let _ = someUndefinedValue"
+ |> assertMessageParts
+ [ TextTag.Text, "The value or constructor '"
+ TextTag.UnresolvedName, "someUndefinedValue"
+ TextTag.Text, "' is not defined." ]
+
+ []
+ let ``Undefined type name is classified`` () =
+ "let _: SomeUndefinedType = ()"
+ |> assertMessageParts
+ [ TextTag.Text, "The type '"
+ TextTag.UnresolvedName, "SomeUndefinedType"
+ TextTag.Text, "' is not defined." ]
+
+ []
+ let ``Undefined name suggestions are classified`` () =
+ """
+let interesting = 1
+let _ = interestinh
+"""
+ |> assertMessageParts
+ [ TextTag.Text, "The value or constructor '"
+ TextTag.UnresolvedName, "interestinh"
+ TextTag.Text, "' is not defined. Maybe you want one of the following:"
+ TextTag.LineBreak, "\n"
+ TextTag.Text, " "
+ TextTag.UnknownEntity, "interesting" ]
+
+ []
+ let ``Message of an unconverted diagnostic is a single part`` () =
+ // FS0067 carries no arguments, so there is nothing in it to classify
+ let diagnostic =
+ diagnostic 67 "let _ = System.Collections.Generic.Dictionary() :?> System.Collections.IDictionary"
+
+ diagnostic.RichMessage.Parts.Length |> shouldEqual 1
+ diagnostic.RichMessage.Text |> shouldEqual diagnostic.Message
+
+ []
+ let ``Type of an ignored result is classified`` () =
+ "1 + 1"
+ |> assertMessagePartsOf
+ 20
+ [ TextTag.Text, "The result of this expression has type '"
+ TextTag.Struct, "int"
+ TextTag.Text, "' and is implicitly ignored. Consider using 'ignore' to discard this value explicitly, e.g. 'expr |> ignore', or 'let' to bind the result to a name, e.g. 'let result = expr'." ]
+
+ []
+ let ``Type of an unexpected function value is classified`` () =
+ """
+let f x = x + 1
+let _: int = f
+"""
+ |> assertMessagePartsOf
+ 1
+ [ TextTag.Text, "This expression was expected to have type\n '"
+ TextTag.Struct, "int"
+ TextTag.Text, "' \nbut here has type\n '"
+ TextTag.Struct, "int"
+ TextTag.Space, " "
+ TextTag.Punctuation, "->"
+ TextTag.Space, " "
+ TextTag.Struct, "int"
+ TextTag.Text, "' " ]
+
+ []
+ let ``Type of a sealed coercion source is classified`` () =
+ "let _ = 1 :?> string"
+ |> assertMessageParts
+ [ TextTag.Text, "The type '"
+ TextTag.Struct, "int"
+ TextTag.Text, "' does not have any proper subtypes and cannot be used as the source of a type test or runtime coercion." ]
+
+ []
+ let ``Types of a mismatch are classified`` () =
+ "let _: int = \"\""
+ |> assertMessagePartsOf
+ 1
+ [ TextTag.Text, "This expression was expected to have type\n '"
+ TextTag.Struct, "int"
+ TextTag.Text, "' \nbut here has type\n '"
+ TextTag.Alias, "string"
+ TextTag.Text, "' " ]
+
+ []
+ let ``Types of a mismatch in a list element are classified`` () =
+ "let _ = [ 1; \"\" ]"
+ |> assertMessagePartsOf
+ 1
+ [ TextTag.Text, "All elements of a list must be implicitly convertible to the type of the first element, which here is '"
+ TextTag.Struct, "int"
+ TextTag.Text, "'. This element has type '"
+ TextTag.Alias, "string"
+ TextTag.Text, "'." ]
+
+ []
+ let ``Type of a missing else branch is classified`` () =
+ "let _ = if true then 1"
+ |> assertMessagePartsOf
+ 1
+ [ TextTag.Text, "This 'if' expression is missing an 'else' branch. Because 'if' is an expression, and not a statement, add an 'else' branch which also returns a value of type '"
+ TextTag.Struct, "int"
+ TextTag.Text, "'." ]
+
+ []
+ let ``Types of a downcast used instead of an upcast are classified`` () =
+ """
+open System.Collections.Generic
+let orig = Dictionary()
+let _ = orig :?> IDictionary
+"""
+ |> assertMessagePartsOf
+ 3198
+ [ TextTag.Text, "The conversion from "
+ TextTag.Class, "Dictionary"
+ TextTag.Punctuation, "<"
+ TextTag.Alias, "obj"
+ TextTag.Punctuation, ","
+ TextTag.Alias, "obj"
+ TextTag.Punctuation, ">"
+ TextTag.Text, " to "
+ TextTag.Interface, "IDictionary"
+ TextTag.Punctuation, "<"
+ TextTag.Alias, "obj"
+ TextTag.Punctuation, ","
+ TextTag.Alias, "obj"
+ TextTag.Punctuation, ">"
+ TextTag.Text, " is a compile-time safe upcast, not a downcast. Consider using the :> (upcast) operator instead of the :?> (downcast) operator." ]
+
+ /// Every part of a type is classified on its own, not just the type as a whole
+ []
+ let ``Parts of a tuple type are classified`` () =
+ "let _: int * int = 1, 2, 3"
+ |> assertMessagePartsOf
+ 1
+ [ TextTag.Text, "Type mismatch. Expecting a tuple of length 2 of type\n "
+ TextTag.Struct, "int"
+ TextTag.Space, " "
+ TextTag.Punctuation, "*"
+ TextTag.Space, " "
+ TextTag.Struct, "int"
+ TextTag.Text, " \nbut given a tuple of length 3 of type\n "
+ TextTag.Struct, "int"
+ TextTag.Space, " "
+ TextTag.Punctuation, "*"
+ TextTag.Space, " "
+ TextTag.Struct, "int"
+ TextTag.Space, " "
+ TextTag.Punctuation, "*"
+ TextTag.Space, " "
+ TextTag.Struct, "int"
+ TextTag.Text, " \n" ]
diff --git a/tests/FSharp.Compiler.ComponentTests/Diagnostics/RichTextTests.fs b/tests/FSharp.Compiler.ComponentTests/Diagnostics/RichTextTests.fs
new file mode 100644
index 00000000000..70924b45dc2
--- /dev/null
+++ b/tests/FSharp.Compiler.ComponentTests/Diagnostics/RichTextTests.fs
@@ -0,0 +1,266 @@
+// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
+
+namespace Diagnostics
+
+open Xunit
+open FSharp.Test
+open FSharp.Test.Assert
+open FSharp.Compiler.Text
+open FSharp.Compiler.Text.Layout
+open FSharp.Compiler.DiagnosticsLogger
+
+module RichTextTests =
+
+ let private tagged tag text = TaggedText(tag, text)
+
+ let private proxy = stringThatIsAProxyForANewlineInFlatErrors
+
+ []
+ let ``Empty text has no parts and empty string`` () =
+ RichText.empty.Parts |> shouldBeEmpty
+ RichText.empty.Text |> shouldEqual ""
+ RichText.empty.IsEmpty |> shouldBeTrue
+
+ []
+ let ``Plain string becomes a single Text part`` () =
+ let text = RichText.mkText "The type 'int' is not defined."
+
+ text |> assertRichTextParts [ TextTag.Text, "The type 'int' is not defined." ]
+ text.Text |> shouldEqual "The type 'int' is not defined."
+
+ []
+ let ``Empty string produces no parts, whatever the classification`` () =
+ (RichText.mkText "").IsEmpty |> shouldBeTrue
+ (RichText.mkMethod "").IsEmpty |> shouldBeTrue
+ (RichText.ofTag TextTag.Class "").IsEmpty |> shouldBeTrue
+
+ []
+ let ``Parts are dumped as tag and text pairs`` () =
+ RichText.ofParts
+ [| tagged TextTag.Text "The type "
+ tagged TextTag.Punctuation "'"
+ tagged TextTag.Class "Foo"
+ tagged TextTag.Punctuation "'" |]
+ |> assertRichTextParts
+ [ TextTag.Text, "The type "
+ TextTag.Punctuation, "'"
+ TextTag.Class, "Foo"
+ TextTag.Punctuation, "'" ]
+
+ []
+ let ``Text is the concatenation of all parts`` () =
+ let text =
+ RichText.ofParts
+ [| tagged TextTag.Text "The type "
+ tagged TextTag.Class "Foo"
+ tagged TextTag.Text " is not defined." |]
+
+ text.Text |> shouldEqual "The type Foo is not defined."
+
+ []
+ let ``Control characters are escaped in the dump`` () =
+ RichText.mkText "line\r\n\tcolumn \"quoted\" back\\slash"
+ |> dumpRichText
+ |> shouldEqual "Text \"line\\r\\n\\tcolumn \\\"quoted\\\" back\\\\slash\""
+
+ /// Equality asks what reaches the reader, so neither the classification nor where the part
+ /// boundaries fall takes part in it
+ []
+ let ``Texts that read the same are equal`` () =
+ let classified =
+ RichText.ofParts [| tagged TextTag.Class "Fo"; tagged TextTag.Struct "o" |]
+
+ classified = RichText.mkText "Foo" |> shouldBeTrue
+ classified.GetHashCode() |> shouldEqual ((RichText.mkText "Foo").GetHashCode())
+
+ RichText.empty = RichText.mkText "" |> shouldBeTrue
+
+ []
+ let ``Texts that read differently are not equal`` () =
+ RichText.ofTaggedText (tagged TextTag.Class "Foo") = RichText.ofTaggedText (tagged TextTag.Class "Bar")
+ |> shouldBeFalse
+
+ RichText.mkText("Foo").Equals(box 1) |> shouldBeFalse
+
+ []
+ let ``Append keeps parts of both sides`` () =
+ RichText.append (RichText.mkText "expected ") (RichText.ofTaggedText (tagged TextTag.Class "int"))
+ |> assertRichTextParts [ TextTag.Text, "expected "; TextTag.Class, "int" ]
+
+ []
+ let ``Append with an empty operand returns the other one`` () =
+ let text = RichText.mkText "abc"
+
+ RichText.append RichText.empty text |> shouldBe text
+ RichText.append text RichText.empty |> shouldBe text
+
+ []
+ let ``Concat flattens all parts in order`` () =
+ let text =
+ RichText.concat
+ [ RichText.mkText "a"
+ RichText.empty
+ RichText.ofTaggedText (tagged TextTag.Keyword "let")
+ RichText.mkText "b" ]
+
+ text |> assertRichTextParts [ TextTag.Text, "a"; TextTag.Keyword, "let"; TextTag.Text, "b" ]
+ text.Text |> shouldEqual "aletb"
+
+ []
+ let ``Concat of nothing is empty`` () =
+ (RichText.concat []).IsEmpty |> shouldBeTrue
+
+ []
+ let ``ConcatWith puts the separator between the texts only`` () =
+ let comma = RichText.mkText ","
+
+ [ RichText.ofTaggedText (tagged TextTag.Class "A")
+ RichText.ofTaggedText (tagged TextTag.Struct "B") ]
+ |> RichText.concatWith comma
+ |> assertRichTextParts [ TextTag.Class, "A"; TextTag.Text, ","; TextTag.Struct, "B" ]
+
+ [ RichText.mkText "only" ] |> RichText.concatWith comma |> assertRichTextParts [ TextTag.Text, "only" ]
+ (RichText.concatWith comma []).IsEmpty |> shouldBeTrue
+
+ []
+ let ``CollectParts can split a part into several`` () =
+ let splitTextOnNewline (part: TaggedText) =
+ if part.Tag <> TextTag.Text then
+ [| part |]
+ else
+ part.Text.Split('\n')
+ |> Array.mapi (fun i line ->
+ if i = 0 then
+ [| tagged TextTag.Text line |]
+ else
+ [| tagged TextTag.LineBreak "\n"; tagged TextTag.Text line |])
+ |> Array.concat
+
+ let text =
+ RichText.ofParts
+ [| tagged TextTag.Text "first\nsecond"
+ tagged TextTag.Class "Foo\nBar" |]
+ |> RichText.collectParts splitTextOnNewline
+
+ text
+ |> assertRichTextParts
+ [ TextTag.Text, "first"
+ TextTag.LineBreak, "\n"
+ TextTag.Text, "second"
+ TextTag.Class, "Foo\nBar" ]
+
+ text.Text |> shouldEqual "first\nsecondFoo\nBar"
+
+ []
+ let ``CollectParts dropping every part gives empty text`` () =
+ (RichText.mkText "abc" |> RichText.collectParts (fun _ -> [||])).IsEmpty
+ |> shouldBeTrue
+
+ []
+ let ``Layout parts are preserved`` () =
+ let layout =
+ wordL (TaggedText.tagKeyword "val") ^^ wordL (TaggedText.tagClass "int")
+
+ let text = LayoutRender.toRichText layout
+
+ text
+ |> assertRichTextParts [ TextTag.Keyword, "val"; TextTag.Space, " "; TextTag.Class, "int" ]
+
+ text.Text |> shouldEqual (LayoutRender.showL layout)
+
+ []
+ let ``Builder appends strings, parts, texts and layouts`` () =
+ let builder = RichTextBuilder()
+ builder.IsEmpty |> shouldBeTrue
+
+ builder.Append "The type "
+ builder.Append ""
+ builder.Append(tagged TextTag.Class "Foo")
+ builder.Append(RichText.mkText " is not compatible with ")
+ builder.Append(LayoutRender.toRichText (wordL (TaggedText.tagClass "Bar")))
+
+ builder.IsEmpty |> shouldBeFalse
+
+ let text = builder.ToRichText()
+
+ text
+ |> assertRichTextParts
+ [ TextTag.Text, "The type "
+ TextTag.Class, "Foo"
+ TextTag.Text, " is not compatible with "
+ TextTag.Class, "Bar" ]
+
+ text.Text |> shouldEqual "The type Foo is not compatible with Bar"
+ builder.ToString() |> shouldEqual text.Text
+
+ []
+ let ``Empty builder produces empty text`` () =
+ let builder = RichTextBuilder()
+ builder.Append ""
+ builder.ToRichText().IsEmpty |> shouldBeTrue
+
+ /// The marker that stands in for a classified argument while the message is formatted is chosen
+ /// absent from the message, so an argument that happens to contain one cannot be mistaken for it
+ []
+ let ``An argument containing a marker character does not corrupt the message`` () =
+ let hostile = "before\u000110\u0001after"
+
+ let text =
+ RichMessage.text (fun rich -> sprintf "%s and %s" hostile (rich (RichText.mkClass "Foo")))
+
+ text.Text |> shouldEqual (sprintf "%s and Foo" hostile)
+ text.Parts |> Array.exists (fun part -> part.Tag = TextTag.Class && part.Text = "Foo") |> shouldBeTrue
+
+ /// The message has to read the same whether or not the arguments are classified
+ []
+ let ``Splicing survives a hole that is reordered, repeated and dropped`` () =
+ let one = RichText.mkClass "One"
+ let two = RichText.mkStruct "Two"
+
+ let text =
+ RichMessage.text (fun rich -> sprintf "%s %s %s" (rich two) (rich one) (rich two))
+
+ text.Text |> shouldEqual "Two One Two"
+
+ text
+ |> assertRichTextParts
+ [ TextTag.Struct, "Two"
+ TextTag.Text, " "
+ TextTag.Class, "One"
+ TextTag.Text, " "
+ TextTag.Struct, "Two" ]
+
+ []
+ let ``Normalization keeps the classification of every part`` () =
+ RichText.ofParts
+ [| tagged TextTag.Text " The type\n"
+ tagged TextTag.Class "Foo\tBar"
+ tagged TextTag.Text "\r\nis not defined. " |]
+ |> NormalizeErrorRichText
+ |> assertRichTextParts
+ [ TextTag.Text, $"The type{proxy}"
+ TextTag.Class, "Foo Bar"
+ TextTag.Text, $"{proxy}is not defined." ]
+
+ []
+ // Line break forms, including ones split across parts
+ []
+ []
+ []
+ []
+ []
+ []
+ []
+ // Control characters
+ []
+ // Trimming spans parts
+ []
+ []
+ []
+ // No normalization needed
+ []
+ let ``Normalization of parts agrees with normalization of the whole message`` (first: string) (second: string) =
+ let text =
+ RichText.ofParts [| tagged TextTag.Text first; tagged TextTag.Class second |]
+
+ (NormalizeErrorRichText text).Text |> shouldEqual (NormalizeErrorString text.Text)
diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj
index 962871768cc..2ccfffa3de2 100644
--- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj
+++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj
@@ -487,6 +487,8 @@
+
+
diff --git a/tests/FSharp.Compiler.Service.Tests/Checker.fs b/tests/FSharp.Compiler.Service.Tests/Checker.fs
index dc86d85c1ad..187d0cc53bf 100644
--- a/tests/FSharp.Compiler.Service.Tests/Checker.fs
+++ b/tests/FSharp.Compiler.Service.Tests/Checker.fs
@@ -302,9 +302,7 @@ module AssertHelpers =
Assert.Equal(1, items.Length)
match items[0] with
| ToolTipElement.Group [ singleElement ] ->
- let toolTipText =
- singleElement.MainDescription
- |> taggedTextToString
- toolTipText, singleElement.XmlDoc, singleElement.Remarks |> Option.map taggedTextToString
+ let toolTipText = singleElement.MainDescription.Text
+ toolTipText, singleElement.XmlDoc, singleElement.Remarks |> Option.map _.Text
| _ -> failwith $"Expected group, got {items[0]}"
diff --git a/tests/FSharp.Compiler.Service.Tests/Common.fs b/tests/FSharp.Compiler.Service.Tests/Common.fs
index a7ca1d2c4f4..1f7d70beb56 100644
--- a/tests/FSharp.Compiler.Service.Tests/Common.fs
+++ b/tests/FSharp.Compiler.Service.Tests/Common.fs
@@ -486,9 +486,6 @@ let findSymbolUse (evaluateSymbol:FSharpSymbolUse->bool) (results: FSharpCheckFi
let symbolUses = getSymbolUses results
symbolUses |> Seq.find (fun symbolUse -> evaluateSymbol symbolUse)
-let taggedTextToString (tts: TaggedText[]) =
- tts |> Array.map (fun tt -> tt.Text) |> String.concat ""
-
let getRangeCoords (r: range) =
(r.StartLine, r.StartColumn), (r.EndLine, r.EndColumn)
diff --git a/tests/FSharp.Compiler.Service.Tests/EditorServiceAsserts.fs b/tests/FSharp.Compiler.Service.Tests/EditorServiceAsserts.fs
index d32b76d097b..c364bac5e9c 100644
--- a/tests/FSharp.Compiler.Service.Tests/EditorServiceAsserts.fs
+++ b/tests/FSharp.Compiler.Service.Tests/EditorServiceAsserts.fs
@@ -41,7 +41,7 @@ module EditorServiceAsserts =
elements
|> List.collect (fun e ->
match e with
- | ToolTipElement.Group items -> items |> List.map (fun d -> taggedTextToString d.MainDescription)
+ | ToolTipElement.Group items -> items |> List.map (fun d -> d.MainDescription.Text)
| _ -> [])
let flattenItemDescription (tooltip: ToolTipText) =
@@ -236,12 +236,12 @@ module EditorServiceAsserts =
| ToolTipElement.Group elements ->
elements
|> List.collect (fun e ->
- [ taggedTextToString e.MainDescription
+ [ e.MainDescription.Text
match e.XmlDoc with
| FSharpXmlDoc.FromXmlText xmlDoc -> String.concat "\n" xmlDoc.UnprocessedLines
| _ -> ""
match e.Remarks with
- | Some r -> taggedTextToString r
+ | Some r -> r.Text
| None -> "" ])
| ToolTipElement.CompositionError err -> [ err ]
| ToolTipElement.None -> [])
@@ -471,7 +471,7 @@ module EditorServiceAsserts =
checkResults.GetMethods(context.Pos.Line, context.Pos.Column, context.LineText, Some context.Names)
let private paramDisplays (m: MethodGroupItem) =
- m.Parameters |> Array.map (fun p -> taggedTextToString p.Display) |> Array.toList
+ m.Parameters |> Array.map (fun p -> p.Display.Text) |> Array.toList
let private describeMethodGroup (mg: MethodGroup) =
if mg.Methods.Length = 0 then
@@ -525,6 +525,6 @@ module EditorServiceAsserts =
let mg = getMethodGroup markedSource
if mg.Methods.Length = 0 then
failwithf "Expected a method group, but got none. Looking for return type %A" expected
- let actual = taggedTextToString mg.Methods[0].ReturnTypeText
+ let actual = mg.Methods[0].ReturnTypeText.Text
if actual <> expected then
failwithf "Expected first overload return type %A but got %A:\n%s" expected actual (describeMethodGroup mg)
diff --git a/tests/FSharp.Compiler.Service.Tests/EditorTests.fs b/tests/FSharp.Compiler.Service.Tests/EditorTests.fs
index be06517681c..259c77917df 100644
--- a/tests/FSharp.Compiler.Service.Tests/EditorTests.fs
+++ b/tests/FSharp.Compiler.Service.Tests/EditorTests.fs
@@ -98,7 +98,7 @@ let ``Intro test`` () =
// Print concatenated parameter lists
[ for mi in methods.Methods do
- yield methods.MethodName , [ for p in mi.Parameters do yield p.Display |> taggedTextToString ] ]
+ yield methods.MethodName , [ for p in mi.Parameters do yield p.Display.Text ] ]
|> shouldEqual
[("Concat", ["[] args: obj []"]);
("Concat", ["[] values: string []"]);
@@ -1970,7 +1970,7 @@ do let x = 1 in ()
let su = checkResults |> findSymbolUseByName "x"
match checkResults.GetDescription(su.Symbol, su.GenericArguments, true, su.Range) with
| ToolTipText [ToolTipElement.Group [data]] ->
- data.MainDescription |> Array.map (fun text -> text.Text) |> String.concat "" |> shouldEqual "val x: int"
+ data.MainDescription.Text |> shouldEqual "val x: int"
| elements -> failwith $"Tooltip elements: {elements}"
let hasRecordField (fieldName:string) (symbolUses: FSharpSymbolUse list) =
diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl
index 0c81c8df894..50178a3e7f9 100644
--- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl
+++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl
@@ -2931,6 +2931,7 @@ FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedDa
FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+TypeExtendedData
FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+TypeMismatchDiagnosticExtendedData
FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+ValueNotContainedDiagnosticExtendedData
+FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Diagnostics.FSharpDiagnostic Create(FSharp.Compiler.Diagnostics.FSharpDiagnosticSeverity, FSharp.Compiler.Text.RichText, Int32, FSharp.Compiler.Text.Range, Microsoft.FSharp.Core.FSharpOption`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.String])
FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Diagnostics.FSharpDiagnostic Create(FSharp.Compiler.Diagnostics.FSharpDiagnosticSeverity, System.String, Int32, FSharp.Compiler.Text.Range, Microsoft.FSharp.Core.FSharpOption`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.String])
FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Diagnostics.FSharpDiagnosticSeverity DefaultSeverity
FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Diagnostics.FSharpDiagnosticSeverity Severity
@@ -2942,6 +2943,8 @@ FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Text.Position get_
FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Text.Position get_Start()
FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Text.Range Range
FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Text.Range get_Range()
+FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Text.RichText RichMessage
+FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Text.RichText get_RichMessage()
FSharp.Compiler.Diagnostics.FSharpDiagnostic: Int32 EndColumn
FSharp.Compiler.Diagnostics.FSharpDiagnostic: Int32 EndLine
FSharp.Compiler.Diagnostics.FSharpDiagnostic: Int32 ErrorNumber
@@ -3797,12 +3800,12 @@ FSharp.Compiler.EditorServices.MethodGroupItem: FSharp.Compiler.EditorServices.T
FSharp.Compiler.EditorServices.MethodGroupItem: FSharp.Compiler.EditorServices.ToolTipText get_Description()
FSharp.Compiler.EditorServices.MethodGroupItem: FSharp.Compiler.Symbols.FSharpXmlDoc XmlDoc
FSharp.Compiler.EditorServices.MethodGroupItem: FSharp.Compiler.Symbols.FSharpXmlDoc get_XmlDoc()
-FSharp.Compiler.EditorServices.MethodGroupItem: FSharp.Compiler.Text.TaggedText[] ReturnTypeText
-FSharp.Compiler.EditorServices.MethodGroupItem: FSharp.Compiler.Text.TaggedText[] get_ReturnTypeText()
+FSharp.Compiler.EditorServices.MethodGroupItem: FSharp.Compiler.Text.RichText ReturnTypeText
+FSharp.Compiler.EditorServices.MethodGroupItem: FSharp.Compiler.Text.RichText get_ReturnTypeText()
FSharp.Compiler.EditorServices.MethodGroupItemParameter: Boolean IsOptional
FSharp.Compiler.EditorServices.MethodGroupItemParameter: Boolean get_IsOptional()
-FSharp.Compiler.EditorServices.MethodGroupItemParameter: FSharp.Compiler.Text.TaggedText[] Display
-FSharp.Compiler.EditorServices.MethodGroupItemParameter: FSharp.Compiler.Text.TaggedText[] get_Display()
+FSharp.Compiler.EditorServices.MethodGroupItemParameter: FSharp.Compiler.Text.RichText Display
+FSharp.Compiler.EditorServices.MethodGroupItemParameter: FSharp.Compiler.Text.RichText get_Display()
FSharp.Compiler.EditorServices.MethodGroupItemParameter: System.String CanonicalTypeTextForSorting
FSharp.Compiler.EditorServices.MethodGroupItemParameter: System.String ParameterName
FSharp.Compiler.EditorServices.MethodGroupItemParameter: System.String get_CanonicalTypeTextForSorting()
@@ -4714,7 +4717,7 @@ FSharp.Compiler.EditorServices.ToolTipElement: Boolean get_IsNone()
FSharp.Compiler.EditorServices.ToolTipElement: FSharp.Compiler.EditorServices.ToolTipElement NewCompositionError(System.String)
FSharp.Compiler.EditorServices.ToolTipElement: FSharp.Compiler.EditorServices.ToolTipElement NewGroup(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.EditorServices.ToolTipElementData])
FSharp.Compiler.EditorServices.ToolTipElement: FSharp.Compiler.EditorServices.ToolTipElement None
-FSharp.Compiler.EditorServices.ToolTipElement: FSharp.Compiler.EditorServices.ToolTipElement Single(FSharp.Compiler.Text.TaggedText[], FSharp.Compiler.Symbols.FSharpXmlDoc, Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Text.TaggedText[]]], Microsoft.FSharp.Core.FSharpOption`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.TaggedText[]], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Symbols.FSharpSymbol])
+FSharp.Compiler.EditorServices.ToolTipElement: FSharp.Compiler.EditorServices.ToolTipElement Single(FSharp.Compiler.Text.RichText, FSharp.Compiler.Symbols.FSharpXmlDoc, Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Text.RichText]], Microsoft.FSharp.Core.FSharpOption`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.RichText], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Symbols.FSharpSymbol])
FSharp.Compiler.EditorServices.ToolTipElement: FSharp.Compiler.EditorServices.ToolTipElement get_None()
FSharp.Compiler.EditorServices.ToolTipElement: FSharp.Compiler.EditorServices.ToolTipElement+CompositionError
FSharp.Compiler.EditorServices.ToolTipElement: FSharp.Compiler.EditorServices.ToolTipElement+Group
@@ -4730,20 +4733,20 @@ FSharp.Compiler.EditorServices.ToolTipElementData: Boolean Equals(System.Object)
FSharp.Compiler.EditorServices.ToolTipElementData: Boolean Equals(System.Object, System.Collections.IEqualityComparer)
FSharp.Compiler.EditorServices.ToolTipElementData: FSharp.Compiler.Symbols.FSharpXmlDoc XmlDoc
FSharp.Compiler.EditorServices.ToolTipElementData: FSharp.Compiler.Symbols.FSharpXmlDoc get_XmlDoc()
-FSharp.Compiler.EditorServices.ToolTipElementData: FSharp.Compiler.Text.TaggedText[] MainDescription
-FSharp.Compiler.EditorServices.ToolTipElementData: FSharp.Compiler.Text.TaggedText[] get_MainDescription()
+FSharp.Compiler.EditorServices.ToolTipElementData: FSharp.Compiler.Text.RichText MainDescription
+FSharp.Compiler.EditorServices.ToolTipElementData: FSharp.Compiler.Text.RichText get_MainDescription()
FSharp.Compiler.EditorServices.ToolTipElementData: Int32 GetHashCode()
FSharp.Compiler.EditorServices.ToolTipElementData: Int32 GetHashCode(System.Collections.IEqualityComparer)
-FSharp.Compiler.EditorServices.ToolTipElementData: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Text.TaggedText[]] TypeMapping
-FSharp.Compiler.EditorServices.ToolTipElementData: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Text.TaggedText[]] get_TypeMapping()
+FSharp.Compiler.EditorServices.ToolTipElementData: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Text.RichText] TypeMapping
+FSharp.Compiler.EditorServices.ToolTipElementData: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Text.RichText] get_TypeMapping()
FSharp.Compiler.EditorServices.ToolTipElementData: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Symbols.FSharpSymbol] Symbol
FSharp.Compiler.EditorServices.ToolTipElementData: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Symbols.FSharpSymbol] get_Symbol()
-FSharp.Compiler.EditorServices.ToolTipElementData: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.TaggedText[]] Remarks
-FSharp.Compiler.EditorServices.ToolTipElementData: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.TaggedText[]] get_Remarks()
+FSharp.Compiler.EditorServices.ToolTipElementData: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.RichText] Remarks
+FSharp.Compiler.EditorServices.ToolTipElementData: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.RichText] get_Remarks()
FSharp.Compiler.EditorServices.ToolTipElementData: Microsoft.FSharp.Core.FSharpOption`1[System.String] ParamName
FSharp.Compiler.EditorServices.ToolTipElementData: Microsoft.FSharp.Core.FSharpOption`1[System.String] get_ParamName()
FSharp.Compiler.EditorServices.ToolTipElementData: System.String ToString()
-FSharp.Compiler.EditorServices.ToolTipElementData: Void .ctor(Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Symbols.FSharpSymbol], FSharp.Compiler.Text.TaggedText[], FSharp.Compiler.Symbols.FSharpXmlDoc, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Text.TaggedText[]], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.TaggedText[]], Microsoft.FSharp.Core.FSharpOption`1[System.String])
+FSharp.Compiler.EditorServices.ToolTipElementData: Void .ctor(Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Symbols.FSharpSymbol], FSharp.Compiler.Text.RichText, FSharp.Compiler.Symbols.FSharpXmlDoc, Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.Text.RichText], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.RichText], Microsoft.FSharp.Core.FSharpOption`1[System.String])
FSharp.Compiler.EditorServices.ToolTipText: Boolean Equals(FSharp.Compiler.EditorServices.ToolTipText)
FSharp.Compiler.EditorServices.ToolTipText: Boolean Equals(FSharp.Compiler.EditorServices.ToolTipText, System.Collections.IEqualityComparer)
FSharp.Compiler.EditorServices.ToolTipText: Boolean Equals(System.Object)
@@ -5713,7 +5716,7 @@ FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue: FSharp.Compiler.Symbols.F
FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue: FSharp.Compiler.Symbols.FSharpXmlDoc get_XmlDoc()
FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue: FSharp.Compiler.Text.Range DeclarationLocation
FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue: FSharp.Compiler.Text.Range get_DeclarationLocation()
-FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue: FSharp.Compiler.Text.TaggedText[] FormatLayout(FSharp.Compiler.Symbols.FSharpDisplayContext)
+FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue: FSharp.Compiler.Text.RichText FormatRichText(FSharp.Compiler.Symbols.FSharpDisplayContext)
FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue: Int32 GetHashCode()
FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Symbols.FSharpEntity] ApparentEnclosingEntity
FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Symbols.FSharpEntity] DeclaringEntity
@@ -5725,7 +5728,7 @@ FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue: Microsoft.FSharp.Core.FSh
FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Symbols.FSharpObsoleteDiagnosticInfo] get_ObsoleteDiagnosticInfo()
FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Symbols.FSharpType] FullTypeSafe
FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Symbols.FSharpType] get_FullTypeSafe()
-FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.TaggedText[]] GetReturnTypeLayout(FSharp.Compiler.Symbols.FSharpDisplayContext)
+FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Text.RichText] GetReturnTypeRichText(FSharp.Compiler.Symbols.FSharpDisplayContext)
FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue: Microsoft.FSharp.Core.FSharpOption`1[System.Collections.Generic.IList`1[FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue]] GetOverloads(Boolean)
FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue: Microsoft.FSharp.Core.FSharpOption`1[System.Object] LiteralValue
FSharp.Compiler.Symbols.FSharpMemberOrFunctionOrValue: Microsoft.FSharp.Core.FSharpOption`1[System.Object] get_LiteralValue()
@@ -5951,8 +5954,8 @@ FSharp.Compiler.Symbols.FSharpType: FSharp.Compiler.Symbols.FSharpType Prettify(
FSharp.Compiler.Symbols.FSharpType: FSharp.Compiler.Symbols.FSharpType StripAbbreviations()
FSharp.Compiler.Symbols.FSharpType: FSharp.Compiler.Symbols.FSharpType get_AbbreviatedType()
FSharp.Compiler.Symbols.FSharpType: FSharp.Compiler.Symbols.FSharpType get_ErasedType()
-FSharp.Compiler.Symbols.FSharpType: FSharp.Compiler.Text.TaggedText[] FormatLayout(FSharp.Compiler.Symbols.FSharpDisplayContext)
-FSharp.Compiler.Symbols.FSharpType: FSharp.Compiler.Text.TaggedText[] FormatLayoutWithConstraints(FSharp.Compiler.Symbols.FSharpDisplayContext)
+FSharp.Compiler.Symbols.FSharpType: FSharp.Compiler.Text.RichText FormatRichText(FSharp.Compiler.Symbols.FSharpDisplayContext)
+FSharp.Compiler.Symbols.FSharpType: FSharp.Compiler.Text.RichText FormatRichTextWithConstraints(FSharp.Compiler.Symbols.FSharpDisplayContext)
FSharp.Compiler.Symbols.FSharpType: Int32 GetHashCode()
FSharp.Compiler.Symbols.FSharpType: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Symbols.FSharpType] BaseType
FSharp.Compiler.Symbols.FSharpType: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.Symbols.FSharpType] get_BaseType()
@@ -11080,6 +11083,61 @@ FSharp.Compiler.Text.RangeModule: System.String stringOfRange(FSharp.Compiler.Te
FSharp.Compiler.Text.RangeModule: System.Tuple`2[System.String,System.Tuple`2[System.Tuple`2[System.Int32,System.Int32],System.Tuple`2[System.Int32,System.Int32]]] toFileZ(FSharp.Compiler.Text.Range)
FSharp.Compiler.Text.RangeModule: System.Tuple`2[System.Tuple`2[System.Int32,System.Int32],System.Tuple`2[System.Int32,System.Int32]] toZ(FSharp.Compiler.Text.Range)
FSharp.Compiler.Text.RangeModule: Void outputRange(System.IO.TextWriter, FSharp.Compiler.Text.Range)
+FSharp.Compiler.Text.RichText: Boolean Equals(System.Object)
+FSharp.Compiler.Text.RichText: Boolean IsEmpty
+FSharp.Compiler.Text.RichText: Boolean get_IsEmpty()
+FSharp.Compiler.Text.RichText: FSharp.Compiler.Text.TaggedText[] Parts
+FSharp.Compiler.Text.RichText: FSharp.Compiler.Text.TaggedText[] get_Parts()
+FSharp.Compiler.Text.RichText: Int32 GetHashCode()
+FSharp.Compiler.Text.RichText: System.String Text
+FSharp.Compiler.Text.RichText: System.String ToString()
+FSharp.Compiler.Text.RichText: System.String get_Text()
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText append(FSharp.Compiler.Text.RichText, FSharp.Compiler.Text.RichText)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText collectParts(Microsoft.FSharp.Core.FSharpFunc`2[FSharp.Compiler.Text.TaggedText,FSharp.Compiler.Text.TaggedText[]], FSharp.Compiler.Text.RichText)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText concat(System.Collections.Generic.IEnumerable`1[FSharp.Compiler.Text.RichText])
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText concatWith(FSharp.Compiler.Text.RichText, System.Collections.Generic.IEnumerable`1[FSharp.Compiler.Text.RichText])
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText empty
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText get_empty()
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkActivePatternCase(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkActivePatternResult(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkAlias(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkClass(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkDelegate(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkEnum(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkEvent(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkField(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkFunction(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkInterface(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkKeyword(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkLocal(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkMember(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkMethod(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkModule(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkModuleBinding(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkNamespace(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkNumericLiteral(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkOperator(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkParameter(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkProperty(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkSpace(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkLineBreak(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkQualifiedName(Microsoft.FSharp.Core.FSharpFunc`2[System.String,FSharp.Compiler.Text.RichText], System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkQualifiedTypeName(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkPunctuation(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkRecord(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkRecordField(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkStringLiteral(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkStruct(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkText(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkTypeParameter(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkUnion(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkUnionCase(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkUnknownEntity(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkUnknownType(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText mkUnresolvedName(System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText ofParts(FSharp.Compiler.Text.TaggedText[])
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText ofTag(FSharp.Compiler.Text.TextTag, System.String)
+FSharp.Compiler.Text.RichTextModule: FSharp.Compiler.Text.RichText ofTaggedText(FSharp.Compiler.Text.TaggedText)
FSharp.Compiler.Text.SourceText: FSharp.Compiler.Text.ISourceText ofString(System.String)
FSharp.Compiler.Text.SourceTextNew: FSharp.Compiler.Text.ISourceTextNew ofISourceText(FSharp.Compiler.Text.ISourceText)
FSharp.Compiler.Text.SourceTextNew: FSharp.Compiler.Text.ISourceTextNew ofString(System.String)
@@ -11139,6 +11197,7 @@ FSharp.Compiler.Text.TextTag+Tags: Int32 TypeParameter
FSharp.Compiler.Text.TextTag+Tags: Int32 Union
FSharp.Compiler.Text.TextTag+Tags: Int32 UnionCase
FSharp.Compiler.Text.TextTag+Tags: Int32 UnknownEntity
+FSharp.Compiler.Text.TextTag+Tags: Int32 UnresolvedName
FSharp.Compiler.Text.TextTag+Tags: Int32 UnknownType
FSharp.Compiler.Text.TextTag: Boolean Equals(FSharp.Compiler.Text.TextTag)
FSharp.Compiler.Text.TextTag: Boolean Equals(FSharp.Compiler.Text.TextTag, System.Collections.IEqualityComparer)
@@ -11177,6 +11236,7 @@ FSharp.Compiler.Text.TextTag: Boolean IsTypeParameter
FSharp.Compiler.Text.TextTag: Boolean IsUnion
FSharp.Compiler.Text.TextTag: Boolean IsUnionCase
FSharp.Compiler.Text.TextTag: Boolean IsUnknownEntity
+FSharp.Compiler.Text.TextTag: Boolean IsUnresolvedName
FSharp.Compiler.Text.TextTag: Boolean IsUnknownType
FSharp.Compiler.Text.TextTag: Boolean get_IsActivePatternCase()
FSharp.Compiler.Text.TextTag: Boolean get_IsActivePatternResult()
@@ -11211,6 +11271,7 @@ FSharp.Compiler.Text.TextTag: Boolean get_IsTypeParameter()
FSharp.Compiler.Text.TextTag: Boolean get_IsUnion()
FSharp.Compiler.Text.TextTag: Boolean get_IsUnionCase()
FSharp.Compiler.Text.TextTag: Boolean get_IsUnknownEntity()
+FSharp.Compiler.Text.TextTag: Boolean get_IsUnresolvedName()
FSharp.Compiler.Text.TextTag: Boolean get_IsUnknownType()
FSharp.Compiler.Text.TextTag: FSharp.Compiler.Text.TextTag ActivePatternCase
FSharp.Compiler.Text.TextTag: FSharp.Compiler.Text.TextTag ActivePatternResult
@@ -11245,6 +11306,7 @@ FSharp.Compiler.Text.TextTag: FSharp.Compiler.Text.TextTag TypeParameter
FSharp.Compiler.Text.TextTag: FSharp.Compiler.Text.TextTag Union
FSharp.Compiler.Text.TextTag: FSharp.Compiler.Text.TextTag UnionCase
FSharp.Compiler.Text.TextTag: FSharp.Compiler.Text.TextTag UnknownEntity
+FSharp.Compiler.Text.TextTag: FSharp.Compiler.Text.TextTag UnresolvedName
FSharp.Compiler.Text.TextTag: FSharp.Compiler.Text.TextTag UnknownType
FSharp.Compiler.Text.TextTag: FSharp.Compiler.Text.TextTag get_ActivePatternCase()
FSharp.Compiler.Text.TextTag: FSharp.Compiler.Text.TextTag get_ActivePatternResult()
@@ -11279,6 +11341,7 @@ FSharp.Compiler.Text.TextTag: FSharp.Compiler.Text.TextTag get_TypeParameter()
FSharp.Compiler.Text.TextTag: FSharp.Compiler.Text.TextTag get_Union()
FSharp.Compiler.Text.TextTag: FSharp.Compiler.Text.TextTag get_UnionCase()
FSharp.Compiler.Text.TextTag: FSharp.Compiler.Text.TextTag get_UnknownEntity()
+FSharp.Compiler.Text.TextTag: FSharp.Compiler.Text.TextTag get_UnresolvedName()
FSharp.Compiler.Text.TextTag: FSharp.Compiler.Text.TextTag get_UnknownType()
FSharp.Compiler.Text.TextTag: FSharp.Compiler.Text.TextTag+Tags
FSharp.Compiler.Text.TextTag: Int32 GetHashCode()
diff --git a/tests/FSharp.Compiler.Service.Tests/FsiHelpTests.fs b/tests/FSharp.Compiler.Service.Tests/FsiHelpTests.fs
index 110cc1a09e7..9a160125733 100644
--- a/tests/FSharp.Compiler.Service.Tests/FsiHelpTests.fs
+++ b/tests/FSharp.Compiler.Service.Tests/FsiHelpTests.fs
@@ -30,7 +30,7 @@ module FsiHelpTests =
[]
let ``Can get help for FSComp.SR.considerUpcast`` () =
- match FSharp.Compiler.Interactive.FsiHelp.Logic.Quoted.tryGetHelp <@ FSComp.SR.considerUpcast @> with
+ match FSharp.Compiler.Interactive.FsiHelp.Logic.Quoted.tryGetHelp <@ (FSComp.SR.considerUpcast: string * string -> int * string) @> with
| ValueSome h ->
h.Assembly |> shouldBe "FSharp.Compiler.Service.dll"
h.FullName |> shouldBe "FSComp.SR.considerUpcast"
diff --git a/tests/FSharp.Compiler.Service.Tests/TooltipTests.fs b/tests/FSharp.Compiler.Service.Tests/TooltipTests.fs
index 5c53e7879ee..b62033007f3 100644
--- a/tests/FSharp.Compiler.Service.Tests/TooltipTests.fs
+++ b/tests/FSharp.Compiler.Service.Tests/TooltipTests.fs
@@ -291,8 +291,7 @@ let testToolTipSquashing source =
| ToolTipElement.Group gr -> gr |> List.map (fun g -> g.MainDescription)
| _ -> failwith "expected TooltipElement.Group")
|> List.concat
- |> Array.concat
- |> Array.sumBy (fun t -> if t.Tag = TextTag.LineBreak then 1 else 0)
+ |> List.sumBy (fun t -> t.Parts |> Array.sumBy (fun t -> if t.Tag = TextTag.LineBreak then 1 else 0))
let squashedBreaks =
groupsSquashed
|> List.map
@@ -301,9 +300,8 @@ let testToolTipSquashing source =
| ToolTipElement.Group gr -> gr |> List.map (fun g -> g.MainDescription)
| _ -> failwith "expected TooltipElement.Group")
|> List.concat
- |> Array.concat
- |> Array.sumBy (fun t -> if t.Tag = TextTag.LineBreak then 1 else 0)
-
+ |> List.sumBy (fun t -> t.Parts |> Array.sumBy (fun t -> if t.Tag = TextTag.LineBreak then 1 else 0))
+
Assert.True(breaks < squashedBreaks)
| _ -> failwith "Expected checking to succeed."
@@ -380,7 +378,7 @@ let getMainDescriptionTags (ToolTipText(items)) =
| _ -> failwith $"Expected single group in tooltip, got {items}"
let assertNameTagInTooltip expectedTag expectedName (tooltip: ToolTipText) =
- let tags = getMainDescriptionTags tooltip
+ let tags = (getMainDescriptionTags tooltip).Parts
let found = tags |> Array.exists (fun t -> t.Tag = expectedTag && t.Text = expectedName)
let desc = tags |> Array.map (fun t -> sprintf "(%A, %s)" t.Tag t.Text) |> String.concat ", "
Assert.True(found, sprintf "Expected tag %A with text '%s' in tooltip, but found: %s" expectedTag expectedName desc)
@@ -893,8 +891,7 @@ let private renderAllGroups (ToolTipText elements) =
match el with
| ToolTipElement.Group items ->
for item in items do
- for line in item.MainDescription do
- sb.Append(line.Text) |> ignore
+ sb.Append(item.MainDescription.Text) |> ignore
sb.Append('\n') |> ignore
for line in item.XmlDoc |> (function FSharpXmlDoc.FromXmlText t -> t.UnprocessedLines |> Array.toList | _ -> []) do
sb.AppendLine(line) |> ignore
diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs
index 723e94345a5..e7b7c8bc247 100644
--- a/tests/FSharp.Test.Utilities/Compiler.fs
+++ b/tests/FSharp.Test.Utilities/Compiler.fs
@@ -422,6 +422,11 @@ $ code --diff {outFile} {expectedFile}
let private fromFSharpDiagnostic (errors: FSharpDiagnostic[]) : (SourceCodeFileName * ErrorInfo) list =
let toErrorInfo (e: FSharpDiagnostic) : SourceCodeFileName * ErrorInfo =
+ // Every diagnostic assertion in the test suite doubles as a check that classifying message
+ // parts doesn't change the message itself. See docs/rich-diagnostics.md.
+ if e.RichMessage.Text <> e.Message then
+ failwith $"Rich message text doesn't match the message.\nMessage: %A{e.Message}\nParts:\n%s{dumpRichText e.RichMessage}"
+
let errorNumber = e.ErrorNumber
let severity = e.Severity
let error =
diff --git a/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj b/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj
index a4f64a0f893..64f2b323a0f 100644
--- a/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj
+++ b/tests/FSharp.Test.Utilities/FSharp.Test.Utilities.fsproj
@@ -34,6 +34,7 @@
+
diff --git a/tests/FSharp.Test.Utilities/RichTextHelpers.fs b/tests/FSharp.Test.Utilities/RichTextHelpers.fs
new file mode 100644
index 00000000000..5a4d75ba2c8
--- /dev/null
+++ b/tests/FSharp.Test.Utilities/RichTextHelpers.fs
@@ -0,0 +1,35 @@
+// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
+
+namespace FSharp.Test
+
+open FSharp.Compiler.Text
+
+[]
+module RichTextHelpers =
+
+ let private escape (text: string) =
+ text
+ .Replace("\\", "\\\\")
+ .Replace("\"", "\\\"")
+ .Replace("\r", "\\r")
+ .Replace("\n", "\\n")
+ .Replace("\t", "\\t")
+
+ /// Renders a single tagged part as `Tag "text"`
+ let dumpTaggedText (part: TaggedText) =
+ sprintf "%A \"%s\"" part.Tag (escape part.Text)
+
+ /// Renders rich text as one `Tag "text"` line per part, so that tag sequences are readable and
+ /// can be compared directly in test expectations.
+ let dumpRichText (text: RichText) =
+ text.Parts |> Array.map dumpTaggedText |> String.concat "\n"
+
+ /// Asserts that rich text consists of exactly the given parts.
+ /// Both sides are compared as dumps, so that a mismatch is reported part by part.
+ let assertRichTextParts (expected: (TextTag * string) list) (text: RichText) =
+ let expected =
+ expected
+ |> List.map (fun (tag, text) -> dumpTaggedText (TaggedText(tag, text)))
+ |> String.concat "\n"
+
+ FSharp.Test.Assert.shouldEqual expected (dumpRichText text)
diff --git a/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs b/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs
index eb951181241..2679740fbb3 100644
--- a/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs
+++ b/vsintegration/src/FSharp.Editor/Common/RoslynHelpers.fs
@@ -98,6 +98,7 @@ module internal RoslynHelpers =
| TextTag.Punctuation -> TextTags.Punctuation
| TextTag.Text
| TextTag.ModuleBinding // why no 'Identifier'? Does it matter?
+ | TextTag.UnresolvedName
| TextTag.UnknownEntity -> TextTags.Text
let CollectTaggedText (list: List<_>) (t: TaggedText) =
@@ -287,11 +288,6 @@ module internal OpenDeclarationHelper =
sourceText, minPos |> Option.defaultValue 0
-[]
-module internal TaggedText =
- let toString (tts: TaggedText[]) =
- tts |> Array.map (fun tt -> tt.Text) |> String.concat ""
-
// http://www.fssnip.net/7S3/title/Intersperse-a-list
module List =
/// The intersperse function takes an element and a list and
diff --git a/vsintegration/src/FSharp.Editor/Completion/SignatureHelp.fs b/vsintegration/src/FSharp.Editor/Completion/SignatureHelp.fs
index f00deaa9250..6afafcc2b4d 100644
--- a/vsintegration/src/FSharp.Editor/Completion/SignatureHelp.fs
+++ b/vsintegration/src/FSharp.Editor/Completion/SignatureHelp.fs
@@ -231,7 +231,7 @@ type internal FSharpSignatureHelpProvider [] (serviceProvi
editorOptions.QuickInfo.ShowRemarks
)
- p.Display |> Seq.iter (RoslynHelpers.CollectTaggedText parts)
+ p.Display.Parts |> Seq.iter (RoslynHelpers.CollectTaggedText parts)
{
ParameterName = p.ParameterName
@@ -456,8 +456,8 @@ type internal FSharpSignatureHelpProvider [] (serviceProvi
if argument.Count = 1 then
let argument = argument.[0]
- let taggedText = argument.Type.FormatLayout symbolUse.DisplayContext
- taggedText |> Seq.iter (RoslynHelpers.CollectTaggedText tt)
+ let typeText = argument.Type.FormatRichText symbolUse.DisplayContext
+ typeText.Parts |> Seq.iter (RoslynHelpers.CollectTaggedText tt)
let name =
let displayName = argument.DisplayName
@@ -515,8 +515,8 @@ type internal FSharpSignatureHelpProvider [] (serviceProvi
let tt = ResizeArray()
- let taggedText = arg.Type.FormatLayout symbolUse.DisplayContext
- taggedText |> Seq.iter (RoslynHelpers.CollectTaggedText tt)
+ let typeText = arg.Type.FormatRichText symbolUse.DisplayContext
+ typeText.Parts |> Seq.iter (RoslynHelpers.CollectTaggedText tt)
let name =
if String.IsNullOrWhiteSpace(arg.DisplayName) then
diff --git a/vsintegration/src/FSharp.Editor/DocComments/XMLDocumentation.fs b/vsintegration/src/FSharp.Editor/DocComments/XMLDocumentation.fs
index 7c587b206c7..02684cece56 100644
--- a/vsintegration/src/FSharp.Editor/DocComments/XMLDocumentation.fs
+++ b/vsintegration/src/FSharp.Editor/DocComments/XMLDocumentation.fs
@@ -468,7 +468,7 @@ module internal XmlDocumentation =
let usageCollector: ITaggedTextCollector =
TextSanitizingCollector(usage.Add, lineLimit = lineLimit)
- let ProcessGenericParameters (tps: TaggedText[] list) =
+ let ProcessGenericParameters (tps: RichText list) =
if not tps.IsEmpty then
AppendHardLine typeParameterMapCollector
AppendOnNewLine typeParameterMapCollector (SR.GenericParametersHeader())
@@ -476,7 +476,7 @@ module internal XmlDocumentation =
for tp in tps do
AppendHardLine typeParameterMapCollector
typeParameterMapCollector.Add(tagSpace " ")
- tp |> Array.iter typeParameterMapCollector.Add
+ tp.Parts |> Array.iter typeParameterMapCollector.Add
let collectDocumentation () =
[ documentation; typeParameterMap; exceptions; usage ]
@@ -489,7 +489,7 @@ module internal XmlDocumentation =
match dataTipElement with
| ToolTipElement.Group overloads when not overloads.IsEmpty ->
overloads[.. overLoadsLimit - 1]
- |> List.map (fun item -> item.MainDescription)
+ |> List.map (fun item -> item.MainDescription.Parts)
|> List.intersperse [| lineBreak |]
|> Seq.concat
|> Seq.iter textCollector.Add
@@ -501,9 +501,9 @@ module internal XmlDocumentation =
item0.Remarks
|> Option.iter (fun r ->
- if TaggedText.toString r <> "" then
+ if r.Text <> "" then
AppendHardLine usageCollector
- r |> Seq.iter usageCollector.Add)
+ r.Parts |> Seq.iter usageCollector.Add)
AppendXmlComment(documentationProvider, xmlCollector, exnCollector, item0.XmlDoc, true, false, showRemarks, item0.ParamName)
@@ -552,7 +552,7 @@ module internal XmlDocumentation =
AddSeparator textCollector
AddSeparator xmlCollector
- let ProcessGenericParameters (tps: TaggedText[] list) =
+ let ProcessGenericParameters (tps: RichText list) =
if not tps.IsEmpty then
AppendHardLine typeParameterMapCollector
AppendOnNewLine typeParameterMapCollector (SR.GenericParametersHeader())
@@ -560,7 +560,7 @@ module internal XmlDocumentation =
for tp in tps do
AppendHardLine typeParameterMapCollector
typeParameterMapCollector.Add(tagSpace " ")
- tp |> Array.iter typeParameterMapCollector.Add
+ tp.Parts |> Array.iter typeParameterMapCollector.Add
let Process add (dataTipElement: ToolTipElement) =
@@ -576,11 +576,11 @@ module internal XmlDocumentation =
if showText then
let AppendOverload (item: ToolTipElementData) =
- if TaggedText.toString item.MainDescription <> "" then
+ if item.MainDescription.Text <> "" then
if not textCollector.IsEmpty then
AppendHardLine textCollector
- item.MainDescription |> Seq.iter textCollector.Add
+ item.MainDescription.Parts |> Seq.iter textCollector.Add
AppendOverload(overloads.[0])
@@ -604,9 +604,9 @@ module internal XmlDocumentation =
item0.Remarks
|> Option.iter (fun r ->
- if TaggedText.toString r <> "" then
+ if r.Text <> "" then
AppendHardLine usageCollector
- r |> Seq.iter usageCollector.Add)
+ r.Parts |> Seq.iter usageCollector.Add)
AppendXmlComment(
documentationProvider,
diff --git a/vsintegration/src/FSharp.Editor/Hints/InlayReturnTypeHints.fs b/vsintegration/src/FSharp.Editor/Hints/InlayReturnTypeHints.fs
index c7f36eec3a7..500014a8943 100644
--- a/vsintegration/src/FSharp.Editor/Hints/InlayReturnTypeHints.fs
+++ b/vsintegration/src/FSharp.Editor/Hints/InlayReturnTypeHints.fs
@@ -12,11 +12,11 @@ open CancellableTasks
type InlayReturnTypeHints(parseFileResults: FSharpParseFileResults, symbol: FSharpMemberOrFunctionOrValue) =
let getHintParts (symbolUse: FSharpSymbolUse) =
- symbol.GetReturnTypeLayout symbolUse.DisplayContext
+ symbol.GetReturnTypeRichText symbolUse.DisplayContext
|> Option.map (fun typeInfo ->
[
TaggedText(TextTag.Text, ": ")
- yield! typeInfo |> Array.toList
+ yield! typeInfo.Parts |> Array.toList
TaggedText(TextTag.Space, " ")
])
diff --git a/vsintegration/src/FSharp.Editor/Hints/InlayTypeHints.fs b/vsintegration/src/FSharp.Editor/Hints/InlayTypeHints.fs
index c5504ef104a..4ffe778fb18 100644
--- a/vsintegration/src/FSharp.Editor/Hints/InlayTypeHints.fs
+++ b/vsintegration/src/FSharp.Editor/Hints/InlayTypeHints.fs
@@ -14,10 +14,10 @@ type InlayTypeHints(parseResults: FSharpParseFileResults, symbol: FSharpMemberOr
let getHintParts (symbol: FSharpMemberOrFunctionOrValue) (symbolUse: FSharpSymbolUse) =
- match symbol.GetReturnTypeLayout symbolUse.DisplayContext with
+ match symbol.GetReturnTypeRichText symbolUse.DisplayContext with
| Some typeInfo ->
let colon = TaggedText(TextTag.Text, ": ")
- colon :: (typeInfo |> Array.toList)
+ colon :: (typeInfo.Parts |> Array.toList)
// not sure when this can happen
| None -> []
diff --git a/vsintegration/src/FSharp.Editor/QuickInfo/Views.fs b/vsintegration/src/FSharp.Editor/QuickInfo/Views.fs
index 146c7d7dfcb..9a398237d7b 100644
--- a/vsintegration/src/FSharp.Editor/QuickInfo/Views.fs
+++ b/vsintegration/src/FSharp.Editor/QuickInfo/Views.fs
@@ -45,6 +45,7 @@ module internal QuickInfoViewProvider =
| TextTag.Operator -> ClassificationTypeNames.Operator
| TextTag.StringLiteral -> ClassificationTypeNames.StringLiteral
| TextTag.Punctuation -> ClassificationTypeNames.Punctuation
+ | TextTag.UnresolvedName
| TextTag.UnknownEntity
| TextTag.Text -> ClassificationTypeNames.Text
diff --git a/vsintegration/src/FSharp.LanguageService/Intellisense.fs b/vsintegration/src/FSharp.LanguageService/Intellisense.fs
index ef24af9b979..6f11b4a4314 100644
--- a/vsintegration/src/FSharp.LanguageService/Intellisense.fs
+++ b/vsintegration/src/FSharp.LanguageService/Intellisense.fs
@@ -24,8 +24,6 @@ open FSharp.Compiler.Tokenization
module internal TaggedText =
let appendTo (sb: System.Text.StringBuilder) (t: TaggedText) = sb.Append t.Text |> ignore
- let toString (tts: TaggedText[]) =
- tts |> Array.map (fun tt -> tt.Text) |> String.concat ""
// Note: DEPRECATED CODE ONLY ACTIVE IN UNIT TESTING VIA "UNROSLYNIZED" UNIT TESTS.
//
@@ -80,12 +78,12 @@ type internal FSharpMethodListForAMethodTip_DEPRECATED(documentationBuilder: IDo
buf.ToString()
)
- override x.GetReturnTypeText(methodIndex) = safe methodIndex "" (fun m -> m.ReturnTypeText |> TaggedText.toString)
+ override x.GetReturnTypeText(methodIndex) = safe methodIndex "" (fun m -> m.ReturnTypeText.Text)
override x.GetParameterCount(methodIndex) = safe methodIndex 0 (fun m -> getParameters(m).Length)
override x.GetParameterInfo(methodIndex, parameterIndex, nameOut, displayOut, descriptionOut) =
- let name,display = safe methodIndex ("","") (fun m -> let p = getParameters(m).[parameterIndex] in p.ParameterName, TaggedText.toString p.Display )
+ let name,display = safe methodIndex ("","") (fun m -> let p = getParameters(m).[parameterIndex] in p.ParameterName, p.Display.Text )
nameOut <- name
displayOut <- display
diff --git a/vsintegration/src/FSharp.LanguageService/XmlDocumentation.fs b/vsintegration/src/FSharp.LanguageService/XmlDocumentation.fs
index bcf60c275ca..93e1a530248 100644
--- a/vsintegration/src/FSharp.LanguageService/XmlDocumentation.fs
+++ b/vsintegration/src/FSharp.LanguageService/XmlDocumentation.fs
@@ -15,11 +15,6 @@ open FSharp.Compiler.Syntax
open FSharp.Compiler.Text
open FSharp.Compiler.Text.TaggedText
-[]
-module internal Utils2 =
- let taggedTextToString (tts: TaggedText[]) =
- tts |> Array.map (fun tt -> tt.Text) |> String.concat ""
-
type internal ITaggedTextCollector_DEPRECATED =
abstract Add: text: TaggedText -> unit
abstract EndsWithLineBreak: bool
@@ -157,9 +152,9 @@ module internal XmlDocumentation =
addSeparatorIfNecessary add
if showText then
let AppendOverload (item :ToolTipElementData) =
- if taggedTextToString item.MainDescription <> "" then
+ if item.MainDescription.Text <> "" then
if not textCollector.IsEmpty then textCollector.Add TaggedText.lineBreak
- item.MainDescription |> Seq.iter textCollector.Add
+ item.MainDescription.Parts |> Seq.iter textCollector.Add
AppendOverload(overloads.[0])
if len >= 2 then AppendOverload(overloads.[1])
@@ -174,7 +169,7 @@ module internal XmlDocumentation =
item0.Remarks |> Option.iter (fun r ->
textCollector.Add TaggedText.lineBreak
- r |> Seq.iter textCollector.Add |> ignore)
+ r.Parts |> Seq.iter textCollector.Add |> ignore)
AppendXmlComment_DEPRECATED(documentationProvider, xmlCollector, item0.XmlDoc, showExceptions, showParameters, item0.ParamName)
diff --git a/vsintegration/tests/FSharp.Editor.Tests/QuickInfoProviderTests.fs b/vsintegration/tests/FSharp.Editor.Tests/QuickInfoProviderTests.fs
index 18cff0490e9..09137e8a57a 100644
--- a/vsintegration/tests/FSharp.Editor.Tests/QuickInfoProviderTests.fs
+++ b/vsintegration/tests/FSharp.Editor.Tests/QuickInfoProviderTests.fs
@@ -43,7 +43,7 @@ module QuickInfoProviderTests =
function
| ToolTipElement.None -> Empty
| ToolTipElement.Group(xs) ->
- let descriptions = xs |> List.map (fun item -> item.MainDescription)
+ let descriptions = xs |> List.map (fun item -> item.MainDescription.Parts)
let descriptionTexts =
descriptions
@@ -51,7 +51,8 @@ module QuickInfoProviderTests =
let descriptionText = descriptionTexts |> Array.concat |> String.concat ""
- let remarks = xs |> List.choose (fun item -> item.Remarks)
+ let remarks =
+ xs |> List.choose (fun item -> item.Remarks |> Option.map (fun r -> r.Parts))
let remarkTexts =
remarks |> Array.concat |> Array.map (fun taggedText -> taggedText.Text)
@@ -61,7 +62,9 @@ module QuickInfoProviderTests =
| [] -> ""
| _ -> "\n" + String.concat "" remarkTexts)
- let tps = xs |> List.collect (fun item -> item.TypeMapping)
+ let tps =
+ xs
+ |> List.collect (fun item -> item.TypeMapping |> List.map (fun tp -> tp.Parts))
let tpTexts =
tps |> List.map (fun x -> x |> Array.map (fun y -> y.Text) |> String.concat "")