CompilerDiagnostics.fs 108.5 KB
Newer Older
1 2 3 4 5 6 7 8
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.

/// Contains logic to prepare, post-process, filter and emit compiler diagnsotics
module internal FSharp.Compiler.CompilerDiagnostics

open System
open System.Diagnostics
open System.IO
D
Don Syme 已提交
9
open System.Reflection
10 11
open System.Text

D
Don Syme 已提交
12 13
open Internal.Utilities.Library.Extras
open Internal.Utilities.Library
14 15 16 17
open Internal.Utilities.Text

open FSharp.Compiler
open FSharp.Compiler.AttributeChecking
18 19
open FSharp.Compiler.CheckExpressions
open FSharp.Compiler.CheckDeclarations
P
Peter Semkin 已提交
20
open FSharp.Compiler.CheckIncrementalClasses
21 22 23 24
open FSharp.Compiler.CompilerConfig
open FSharp.Compiler.CompilerImports
open FSharp.Compiler.ConstraintSolver
open FSharp.Compiler.DiagnosticMessage
D
Don Syme 已提交
25
open FSharp.Compiler.Diagnostics
D
Don Syme 已提交
26
open FSharp.Compiler.DiagnosticsLogger
27
open FSharp.Compiler.Infos
D
Don Syme 已提交
28
open FSharp.Compiler.IO
29 30 31 32 33 34
open FSharp.Compiler.Lexhelp
open FSharp.Compiler.MethodCalls
open FSharp.Compiler.MethodOverrides
open FSharp.Compiler.NameResolution
open FSharp.Compiler.ParseHelpers
open FSharp.Compiler.SignatureConformance
D
Don Syme 已提交
35 36 37 38 39
open FSharp.Compiler.Syntax
open FSharp.Compiler.Syntax.PrettyNaming
open FSharp.Compiler.Text
open FSharp.Compiler.Text.Position
open FSharp.Compiler.Text.Range
40 41 42 43 44
open FSharp.Compiler.TypedTree
open FSharp.Compiler.TypedTreeBasics
open FSharp.Compiler.TypedTreeOps

#if DEBUG
45
let showAssertForUnexpectedException = ref true
D
Don Syme 已提交
46
#endif
47

48 49 50 51 52 53 54
/// This exception is an old-style way of reporting a diagnostic
exception HashIncludeNotAllowedInNonScript of range

/// This exception is an old-style way of reporting a diagnostic
exception HashReferenceNotAllowedInNonScript of range

/// This exception is an old-style way of reporting a diagnostic
55
exception HashLoadedSourceHasIssues of informationals: exn list * warnings: exn list * errors: exn list * range
56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77

/// This exception is an old-style way of reporting a diagnostic
exception HashLoadedScriptConsideredSource of range

/// This exception is an old-style way of reporting a diagnostic
exception HashDirectiveNotAllowedInNonScript of range

/// This exception is an old-style way of reporting a diagnostic
exception DeprecatedCommandLineOptionFull of string * range

/// This exception is an old-style way of reporting a diagnostic
exception DeprecatedCommandLineOptionForHtmlDoc of string * range

/// This exception is an old-style way of reporting a diagnostic
exception DeprecatedCommandLineOptionSuggestAlternative of string * string * range

/// This exception is an old-style way of reporting a diagnostic
exception DeprecatedCommandLineOptionNoDescription of string * range

/// This exception is an old-style way of reporting a diagnostic
exception InternalCommandLineOption of string * range

78 79 80
type Exception with

    member exn.DiagnosticRange =
D
Don Syme 已提交
81
        match exn with
82
        | ErrorFromAddingConstraint (_, exn2, _) -> exn2.DiagnosticRange
83
#if !NO_TYPEPROVIDERS
84
        | TypeProviders.ProvidedTypeResolutionNoRange exn -> exn.DiagnosticRange
D
Don Syme 已提交
85
        | TypeProviders.ProvidedTypeResolution (m, _)
86
#endif
D
Don Syme 已提交
87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125
        | ReservedKeyword (_, m)
        | IndentationProblem (_, m)
        | ErrorFromAddingTypeEquation (_, _, _, _, _, m)
        | ErrorFromApplyingDefault (_, _, _, _, _, m)
        | ErrorsFromAddingSubsumptionConstraint (_, _, _, _, _, _, m)
        | FunctionExpected (_, _, m)
        | BakedInMemberConstraintName (_, m)
        | StandardOperatorRedefinitionWarning (_, m)
        | BadEventTransformation m
        | ParameterlessStructCtor m
        | FieldNotMutable (_, _, m)
        | Recursion (_, _, _, _, m)
        | InvalidRuntimeCoercion (_, _, _, m)
        | IndeterminateRuntimeCoercion (_, _, _, m)
        | IndeterminateStaticCoercion (_, _, _, m)
        | StaticCoercionShouldUseBox (_, _, _, m)
        | CoercionTargetSealed (_, _, m)
        | UpcastUnnecessary m
        | QuotationTranslator.IgnoringPartOfQuotedTermWarning (_, m)

        | TypeTestUnnecessary m
        | RuntimeCoercionSourceSealed (_, _, m)
        | OverrideDoesntOverride (_, _, _, _, _, m)
        | UnionPatternsBindDifferentNames m
        | UnionCaseWrongArguments (_, _, _, m)
        | TypeIsImplicitlyAbstract m
        | RequiredButNotSpecified (_, _, _, _, m)
        | FunctionValueUnexpected (_, _, m)
        | UnitTypeExpected (_, _, m)
        | UnitTypeExpectedWithEquality (_, _, m)
        | UnitTypeExpectedWithPossiblePropertySetter (_, _, _, _, m)
        | UnitTypeExpectedWithPossibleAssignment (_, _, _, _, m)
        | UseOfAddressOfOperator m
        | DeprecatedThreadStaticBindingWarning m
        | NonUniqueInferredAbstractSlot (_, _, _, _, _, m)
        | DefensiveCopyWarning (_, m)
        | LetRecCheckedAtRuntime m
        | UpperCaseIdentifierInPattern m
        | NotUpperCaseConstructor m
126
        | NotUpperCaseConstructorWithoutRQA m
D
Don Syme 已提交
127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172
        | RecursiveUseCheckedAtRuntime (_, _, m)
        | LetRecEvaluatedOutOfOrder (_, _, _, m)
        | DiagnosticWithText (_, _, m)
        | DiagnosticWithSuggestions (_, _, m, _, _)
        | SyntaxError (_, m)
        | InternalError (_, m)
        | InterfaceNotRevealed (_, _, m)
        | WrappedError (_, m)
        | PatternMatchCompilation.MatchIncomplete (_, _, m)
        | PatternMatchCompilation.EnumMatchIncomplete (_, _, m)
        | PatternMatchCompilation.RuleNeverMatched m
        | ValNotMutable (_, _, m)
        | ValNotLocal (_, _, m)
        | MissingFields (_, m)
        | OverrideInIntrinsicAugmentation m
        | IntfImplInIntrinsicAugmentation m
        | OverrideInExtrinsicAugmentation m
        | IntfImplInExtrinsicAugmentation m
        | ValueRestriction (_, _, _, _, _, m)
        | LetRecUnsound (_, _, m)
        | ObsoleteError (_, m)
        | ObsoleteWarning (_, m)
        | Experimental (_, m)
        | PossibleUnverifiableCode m
        | UserCompilerMessage (_, _, m)
        | Deprecated (_, m)
        | LibraryUseOnly m
        | FieldsFromDifferentTypes (_, _, _, m)
        | IndeterminateType m
        | TyconBadArgs (_, _, _, m) -> Some m

        | FieldNotContained (_, _, _, arf, _, _) -> Some arf.Range
        | ValueNotContained (_, _, _, aval, _, _) -> Some aval.Range
        | UnionCaseNotContained (_, _, _, aval, _, _) -> Some aval.Id.idRange
        | FSharpExceptionNotContained (_, _, aexnc, _, _) -> Some aexnc.Range

        | VarBoundTwice id
        | UndefinedName (_, _, id, _) -> Some id.idRange

        | Duplicate (_, _, m)
        | NameClash (_, _, _, m, _, _, _)
        | UnresolvedOverloading (_, _, _, m)
        | UnresolvedConversionOperator (_, _, _, m)
        | VirtualAugmentationOnNullValuedType m
        | NonVirtualAugmentationOnNullValuedType m
        | NonRigidTypar (_, _, _, _, _, m)
173
        | ConstraintSolverTupleDiffLengths (_, _, _, _, m, _)
D
Don Syme 已提交
174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204
        | ConstraintSolverInfiniteTypes (_, _, _, _, m, _)
        | ConstraintSolverMissingConstraint (_, _, _, m, _)
        | ConstraintSolverTypesNotInEqualityRelation (_, _, _, m, _, _)
        | ConstraintSolverError (_, m, _)
        | ConstraintSolverTypesNotInSubsumptionRelation (_, _, _, m, _)
        | SelfRefObjCtor (_, m) -> Some m

        | NotAFunction (_, _, mfun, _) -> Some mfun

        | NotAFunctionButIndexer (_, _, _, mfun, _, _) -> Some mfun

        | IllegalFileNameChar _ -> Some rangeCmdArgs

        | UnresolvedReferenceError (_, m)
        | UnresolvedPathReference (_, _, m)
        | DeprecatedCommandLineOptionFull (_, m)
        | DeprecatedCommandLineOptionForHtmlDoc (_, m)
        | DeprecatedCommandLineOptionSuggestAlternative (_, _, m)
        | DeprecatedCommandLineOptionNoDescription (_, m)
        | InternalCommandLineOption (_, m)
        | HashIncludeNotAllowedInNonScript m
        | HashReferenceNotAllowedInNonScript m
        | HashDirectiveNotAllowedInNonScript m
        | FileNameNotResolved (_, _, m)
        | LoadedSourceNotFoundIgnoring (_, m)
        | MSBuildReferenceResolutionWarning (_, _, m)
        | MSBuildReferenceResolutionError (_, _, m)
        | AssemblyNotResolved (_, m)
        | HashLoadedSourceHasIssues (_, _, _, m)
        | HashLoadedScriptConsideredSource m -> Some m
        // Strip TargetInvocationException wrappers
205
        | :? System.Reflection.TargetInvocationException as e -> e.InnerException.DiagnosticRange
206
#if !NO_TYPEPROVIDERS
D
Don Syme 已提交
207
        | :? TypeProviderError as e -> e.Range |> Some
208
#endif
D
Don Syme 已提交
209 210
        | _ -> None

211
    member exn.DiagnosticNumber =
D
Don Syme 已提交
212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242
        match exn with
        // DO NOT CHANGE THESE NUMBERS
        | ErrorFromAddingTypeEquation _ -> 1
        | FunctionExpected _ -> 2
        | NotAFunctionButIndexer _ -> 3217
        | NotAFunction _ -> 3
        | FieldNotMutable _ -> 5
        | Recursion _ -> 6
        | InvalidRuntimeCoercion _ -> 7
        | IndeterminateRuntimeCoercion _ -> 8
        | PossibleUnverifiableCode _ -> 9
        | SyntaxError _ -> 10
        // 11 cannot be reused
        // 12 cannot be reused
        | IndeterminateStaticCoercion _ -> 13
        | StaticCoercionShouldUseBox _ -> 14
        // 15 cannot be reused
        | RuntimeCoercionSourceSealed _ -> 16
        | OverrideDoesntOverride _ -> 17
        | UnionPatternsBindDifferentNames _ -> 18
        | UnionCaseWrongArguments _ -> 19
        | UnitTypeExpected _ -> 20
        | UnitTypeExpectedWithEquality _ -> 20
        | UnitTypeExpectedWithPossiblePropertySetter _ -> 20
        | UnitTypeExpectedWithPossibleAssignment _ -> 20
        | RecursiveUseCheckedAtRuntime _ -> 21
        | LetRecEvaluatedOutOfOrder _ -> 22
        | NameClash _ -> 23
        // 24 cannot be reused
        | PatternMatchCompilation.MatchIncomplete _ -> 25
        | PatternMatchCompilation.RuleNeverMatched _ -> 26
243

D
Don Syme 已提交
244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269
        | ValNotMutable _ -> 27
        | ValNotLocal _ -> 28
        | MissingFields _ -> 29
        | ValueRestriction _ -> 30
        | LetRecUnsound _ -> 31
        | FieldsFromDifferentTypes _ -> 32
        | TyconBadArgs _ -> 33
        | ValueNotContained _ -> 34
        | Deprecated _ -> 35
        | UnionCaseNotContained _ -> 36
        | Duplicate _ -> 37
        | VarBoundTwice _ -> 38
        | UndefinedName _ -> 39
        | LetRecCheckedAtRuntime _ -> 40
        | UnresolvedOverloading _ -> 41
        | LibraryUseOnly _ -> 42
        | ErrorFromAddingConstraint _ -> 43
        | ObsoleteWarning _ -> 44
        | ReservedKeyword _ -> 46
        | SelfRefObjCtor _ -> 47
        | VirtualAugmentationOnNullValuedType _ -> 48
        | UpperCaseIdentifierInPattern _ -> 49
        | InterfaceNotRevealed _ -> 50
        | UseOfAddressOfOperator _ -> 51
        | DefensiveCopyWarning _ -> 52
        | NotUpperCaseConstructor _ -> 53
270
        | NotUpperCaseConstructorWithoutRQA _ -> 53
D
Don Syme 已提交
271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321
        | TypeIsImplicitlyAbstract _ -> 54
        // 55 cannot be reused
        | DeprecatedThreadStaticBindingWarning _ -> 56
        | Experimental _ -> 57
        | IndentationProblem _ -> 58
        | CoercionTargetSealed _ -> 59
        | OverrideInIntrinsicAugmentation _ -> 60
        | NonVirtualAugmentationOnNullValuedType _ -> 61
        | UserCompilerMessage (_, n, _) -> n
        | FSharpExceptionNotContained _ -> 63
        | NonRigidTypar _ -> 64
        // 65 cannot be reused
        | UpcastUnnecessary _ -> 66
        | TypeTestUnnecessary _ -> 67
        | QuotationTranslator.IgnoringPartOfQuotedTermWarning _ -> 68
        | IntfImplInIntrinsicAugmentation _ -> 69
        | NonUniqueInferredAbstractSlot _ -> 70
        | ErrorFromApplyingDefault _ -> 71
        | IndeterminateType _ -> 72
        | InternalError _ -> 73
        | UnresolvedReferenceNoRange _
        | UnresolvedReferenceError _
        | UnresolvedPathReferenceNoRange _
        | UnresolvedPathReference _ -> 74
        | DeprecatedCommandLineOptionFull _
        | DeprecatedCommandLineOptionForHtmlDoc _
        | DeprecatedCommandLineOptionSuggestAlternative _
        | DeprecatedCommandLineOptionNoDescription _
        | InternalCommandLineOption _ -> 75
        | HashIncludeNotAllowedInNonScript _
        | HashReferenceNotAllowedInNonScript _
        | HashDirectiveNotAllowedInNonScript _ -> 76
        | BakedInMemberConstraintName _ -> 77
        | FileNameNotResolved _ -> 78
        | LoadedSourceNotFoundIgnoring _ -> 79
        // 80 cannot be reused
        | ParameterlessStructCtor _ -> 81
        | MSBuildReferenceResolutionWarning _ -> 82
        | MSBuildReferenceResolutionError _ -> 83
        | AssemblyNotResolved _ -> 84
        | HashLoadedSourceHasIssues _ -> 85
        | StandardOperatorRedefinitionWarning _ -> 86
        | InvalidInternalsVisibleToAssemblyName _ -> 87
        // 88 cannot be reused
        | OverrideInExtrinsicAugmentation _ -> 89
        | IntfImplInExtrinsicAugmentation _ -> 90
        | BadEventTransformation _ -> 91
        | HashLoadedScriptConsideredSource _ -> 92
        | UnresolvedConversionOperator _ -> 93
        // avoid 94-100 for safety
        | ObsoleteError _ -> 101
322
#if !NO_TYPEPROVIDERS
D
Don Syme 已提交
323 324
        | TypeProviders.ProvidedTypeResolutionNoRange _
        | TypeProviders.ProvidedTypeResolution _ -> 103
325
#endif
D
Don Syme 已提交
326
        | PatternMatchCompilation.EnumMatchIncomplete _ -> 104
327

D
Don Syme 已提交
328
        // Strip TargetInvocationException wrappers
329 330
        | :? TargetInvocationException as e -> e.InnerException.DiagnosticNumber
        | WrappedError (e, _) -> e.DiagnosticNumber
D
Don Syme 已提交
331 332 333 334
        | DiagnosticWithText (n, _, _) -> n
        | DiagnosticWithSuggestions (n, _, _, _, _) -> n
        | Failure _ -> 192
        | IllegalFileNameChar (fileName, invalidChar) -> fst (FSComp.SR.buildUnexpectedFileNameCharacter (fileName, string invalidChar))
335
#if !NO_TYPEPROVIDERS
D
Don Syme 已提交
336
        | :? TypeProviderError as e -> e.Number
337
#endif
D
Don Syme 已提交
338 339 340 341
        | ErrorsFromAddingSubsumptionConstraint (_, _, _, _, _, ContextInfo.DowncastUsedInsteadOfUpcast _, _) ->
            fst (FSComp.SR.considerUpcast ("", ""))
        | _ -> 193

342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427
type PhasedDiagnostic with

    member x.Range = x.Exception.DiagnosticRange

    member x.Number = x.Exception.DiagnosticNumber

    member x.WarningLevel =
        match x.Exception with
        // Level 5 warnings
        | RecursiveUseCheckedAtRuntime _
        | LetRecEvaluatedOutOfOrder _
        | DefensiveCopyWarning _ -> 5

        | DiagnosticWithText (n, _, _)
        | DiagnosticWithSuggestions (n, _, _, _, _) ->
            // 1178, tcNoComparisonNeeded1, "The struct, record or union type '%s' is not structurally comparable because the type parameter %s does not satisfy the 'comparison' constraint..."
            // 1178, tcNoComparisonNeeded2, "The struct, record or union type '%s' is not structurally comparable because the type '%s' does not satisfy the 'comparison' constraint...."
            // 1178, tcNoEqualityNeeded1, "The struct, record or union type '%s' does not support structural equality because the type parameter %s does not satisfy the 'equality' constraint..."
            // 1178, tcNoEqualityNeeded2, "The struct, record or union type '%s' does not support structural equality because the type '%s' does not satisfy the 'equality' constraint...."
            if (n = 1178) then 5 else 2
        // Level 2
        | _ -> 2

    member x.IsEnabled(severity, options) =
        let level = options.WarnLevel
        let specificWarnOn = options.WarnOn
        let n = x.Number

        List.contains n specificWarnOn
        ||
        // Some specific warnings/informational are never on by default, i.e. unused variable warnings
        match n with
        | 1182 -> false // chkUnusedValue - off by default
        | 3180 -> false // abImplicitHeapAllocation - off by default
        | 3186 -> false // pickleMissingDefinition - off by default
        | 3366 -> false //tcIndexNotationDeprecated - currently off by default
        | 3517 -> false // optFailedToInlineSuggestedValue - off by default
        | 3388 -> false // tcSubsumptionImplicitConversionUsed - off by default
        | 3389 -> false // tcBuiltInImplicitConversionUsed - off by default
        | 3390 -> false // xmlDocBadlyFormed - off by default
        | 3395 -> false // tcImplicitConversionUsedForMethodArg - off by default
        | _ ->
            (severity = FSharpDiagnosticSeverity.Info)
            || (severity = FSharpDiagnosticSeverity.Warning && level >= x.WarningLevel)

    /// Indicates if a diagnostic should be reported as an informational
    member x.ReportAsInfo(options, severity) =
        match severity with
        | FSharpDiagnosticSeverity.Error -> false
        | FSharpDiagnosticSeverity.Warning -> false
        | FSharpDiagnosticSeverity.Info -> x.IsEnabled(severity, options) && not (List.contains x.Number options.WarnOff)
        | FSharpDiagnosticSeverity.Hidden -> false

    /// Indicates if a diagnostic should be reported as a warning
    member x.ReportAsWarning(options, severity) =
        match severity with
        | FSharpDiagnosticSeverity.Error -> false

        | FSharpDiagnosticSeverity.Warning -> x.IsEnabled(severity, options) && not (List.contains x.Number options.WarnOff)

        // Informational become warning if explicitly on and not explicitly off
        | FSharpDiagnosticSeverity.Info ->
            let n = x.Number
            List.contains n options.WarnOn && not (List.contains n options.WarnOff)

        | FSharpDiagnosticSeverity.Hidden -> false

    /// Indicates if a diagnostic should be reported as an error
    member x.ReportAsError(options, severity) =

        match severity with
        | FSharpDiagnosticSeverity.Error -> true

        // Warnings become errors in some situations
        | FSharpDiagnosticSeverity.Warning ->
            let n = x.Number

            x.IsEnabled(severity, options)
            && not (List.contains n options.WarnAsWarn)
            && ((options.GlobalWarnAsError && not (List.contains n options.WarnOff))
                || List.contains n options.WarnAsError)

        // Informational become errors if explicitly WarnAsError
        | FSharpDiagnosticSeverity.Info -> List.contains x.Number options.WarnAsError

        | FSharpDiagnosticSeverity.Hidden -> false
D
Don Syme 已提交
428

429 430 431 432 433 434 435 436 437 438 439 440 441 442
[<AutoOpen>]
module OldStyleMessages =
    let Message (name, format) = DeclareResourceString(name, format)

    do FSComp.SR.RunStartupValidation()
    let SeeAlsoE () = Message("SeeAlso", "%s")
    let ConstraintSolverTupleDiffLengthsE () = Message("ConstraintSolverTupleDiffLengths", "%d%d")
    let ConstraintSolverInfiniteTypesE () = Message("ConstraintSolverInfiniteTypes", "%s%s")
    let ConstraintSolverMissingConstraintE () = Message("ConstraintSolverMissingConstraint", "%s")
    let ConstraintSolverTypesNotInEqualityRelation1E () = Message("ConstraintSolverTypesNotInEqualityRelation1", "%s%s")
    let ConstraintSolverTypesNotInEqualityRelation2E () = Message("ConstraintSolverTypesNotInEqualityRelation2", "%s%s")
    let ConstraintSolverTypesNotInSubsumptionRelationE () = Message("ConstraintSolverTypesNotInSubsumptionRelation", "%s%s%s")
    let ErrorFromAddingTypeEquation1E () = Message("ErrorFromAddingTypeEquation1", "%s%s%s")
    let ErrorFromAddingTypeEquation2E () = Message("ErrorFromAddingTypeEquation2", "%s%s%s")
443
    let ErrorFromAddingTypeEquationTuplesE () = Message("ErrorFromAddingTypeEquationTuples", "%d%s%d%s%s")
444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593
    let ErrorFromApplyingDefault1E () = Message("ErrorFromApplyingDefault1", "%s")
    let ErrorFromApplyingDefault2E () = Message("ErrorFromApplyingDefault2", "")
    let ErrorsFromAddingSubsumptionConstraintE () = Message("ErrorsFromAddingSubsumptionConstraint", "%s%s%s")
    let UpperCaseIdentifierInPatternE () = Message("UpperCaseIdentifierInPattern", "")
    let NotUpperCaseConstructorE () = Message("NotUpperCaseConstructor", "")
    let NotUpperCaseConstructorWithoutRQAE () = Message("NotUpperCaseConstructorWithoutRQA", "")
    let FunctionExpectedE () = Message("FunctionExpected", "")
    let BakedInMemberConstraintNameE () = Message("BakedInMemberConstraintName", "%s")
    let BadEventTransformationE () = Message("BadEventTransformation", "")
    let ParameterlessStructCtorE () = Message("ParameterlessStructCtor", "")
    let InterfaceNotRevealedE () = Message("InterfaceNotRevealed", "%s")
    let TyconBadArgsE () = Message("TyconBadArgs", "%s%d%d")
    let IndeterminateTypeE () = Message("IndeterminateType", "")
    let NameClash1E () = Message("NameClash1", "%s%s")
    let NameClash2E () = Message("NameClash2", "%s%s%s%s%s")
    let Duplicate1E () = Message("Duplicate1", "%s")
    let Duplicate2E () = Message("Duplicate2", "%s%s")
    let UndefinedName2E () = Message("UndefinedName2", "")
    let FieldNotMutableE () = Message("FieldNotMutable", "")
    let FieldsFromDifferentTypesE () = Message("FieldsFromDifferentTypes", "%s%s")
    let VarBoundTwiceE () = Message("VarBoundTwice", "%s")
    let RecursionE () = Message("Recursion", "%s%s%s%s")
    let InvalidRuntimeCoercionE () = Message("InvalidRuntimeCoercion", "%s%s%s")
    let IndeterminateRuntimeCoercionE () = Message("IndeterminateRuntimeCoercion", "%s%s")
    let IndeterminateStaticCoercionE () = Message("IndeterminateStaticCoercion", "%s%s")
    let StaticCoercionShouldUseBoxE () = Message("StaticCoercionShouldUseBox", "%s%s")
    let TypeIsImplicitlyAbstractE () = Message("TypeIsImplicitlyAbstract", "")
    let NonRigidTypar1E () = Message("NonRigidTypar1", "%s%s")
    let NonRigidTypar2E () = Message("NonRigidTypar2", "%s%s")
    let NonRigidTypar3E () = Message("NonRigidTypar3", "%s%s")
    let OBlockEndSentenceE () = Message("BlockEndSentence", "")
    let UnexpectedEndOfInputE () = Message("UnexpectedEndOfInput", "")
    let UnexpectedE () = Message("Unexpected", "%s")
    let NONTERM_interactionE () = Message("NONTERM.interaction", "")
    let NONTERM_hashDirectiveE () = Message("NONTERM.hashDirective", "")
    let NONTERM_fieldDeclE () = Message("NONTERM.fieldDecl", "")
    let NONTERM_unionCaseReprE () = Message("NONTERM.unionCaseRepr", "")
    let NONTERM_localBindingE () = Message("NONTERM.localBinding", "")
    let NONTERM_hardwhiteLetBindingsE () = Message("NONTERM.hardwhiteLetBindings", "")
    let NONTERM_classDefnMemberE () = Message("NONTERM.classDefnMember", "")
    let NONTERM_defnBindingsE () = Message("NONTERM.defnBindings", "")
    let NONTERM_classMemberSpfnE () = Message("NONTERM.classMemberSpfn", "")
    let NONTERM_valSpfnE () = Message("NONTERM.valSpfn", "")
    let NONTERM_tyconSpfnE () = Message("NONTERM.tyconSpfn", "")
    let NONTERM_anonLambdaExprE () = Message("NONTERM.anonLambdaExpr", "")
    let NONTERM_attrUnionCaseDeclE () = Message("NONTERM.attrUnionCaseDecl", "")
    let NONTERM_cPrototypeE () = Message("NONTERM.cPrototype", "")
    let NONTERM_objectImplementationMembersE () = Message("NONTERM.objectImplementationMembers", "")
    let NONTERM_ifExprCasesE () = Message("NONTERM.ifExprCases", "")
    let NONTERM_openDeclE () = Message("NONTERM.openDecl", "")
    let NONTERM_fileModuleSpecE () = Message("NONTERM.fileModuleSpec", "")
    let NONTERM_patternClausesE () = Message("NONTERM.patternClauses", "")
    let NONTERM_beginEndExprE () = Message("NONTERM.beginEndExpr", "")
    let NONTERM_recdExprE () = Message("NONTERM.recdExpr", "")
    let NONTERM_tyconDefnE () = Message("NONTERM.tyconDefn", "")
    let NONTERM_exconCoreE () = Message("NONTERM.exconCore", "")
    let NONTERM_typeNameInfoE () = Message("NONTERM.typeNameInfo", "")
    let NONTERM_attributeListE () = Message("NONTERM.attributeList", "")
    let NONTERM_quoteExprE () = Message("NONTERM.quoteExpr", "")
    let NONTERM_typeConstraintE () = Message("NONTERM.typeConstraint", "")
    let NONTERM_Category_ImplementationFileE () = Message("NONTERM.Category.ImplementationFile", "")
    let NONTERM_Category_DefinitionE () = Message("NONTERM.Category.Definition", "")
    let NONTERM_Category_SignatureFileE () = Message("NONTERM.Category.SignatureFile", "")
    let NONTERM_Category_PatternE () = Message("NONTERM.Category.Pattern", "")
    let NONTERM_Category_ExprE () = Message("NONTERM.Category.Expr", "")
    let NONTERM_Category_TypeE () = Message("NONTERM.Category.Type", "")
    let NONTERM_typeArgsActualE () = Message("NONTERM.typeArgsActual", "")
    let TokenName1E () = Message("TokenName1", "%s")
    let TokenName1TokenName2E () = Message("TokenName1TokenName2", "%s%s")
    let TokenName1TokenName2TokenName3E () = Message("TokenName1TokenName2TokenName3", "%s%s%s")
    let RuntimeCoercionSourceSealed1E () = Message("RuntimeCoercionSourceSealed1", "%s")
    let RuntimeCoercionSourceSealed2E () = Message("RuntimeCoercionSourceSealed2", "%s")
    let CoercionTargetSealedE () = Message("CoercionTargetSealed", "%s")
    let UpcastUnnecessaryE () = Message("UpcastUnnecessary", "")
    let TypeTestUnnecessaryE () = Message("TypeTestUnnecessary", "")
    let OverrideDoesntOverride1E () = Message("OverrideDoesntOverride1", "%s")
    let OverrideDoesntOverride2E () = Message("OverrideDoesntOverride2", "%s")
    let OverrideDoesntOverride3E () = Message("OverrideDoesntOverride3", "%s")
    let OverrideDoesntOverride4E () = Message("OverrideDoesntOverride4", "%s")
    let UnionCaseWrongArgumentsE () = Message("UnionCaseWrongArguments", "%d%d")
    let UnionPatternsBindDifferentNamesE () = Message("UnionPatternsBindDifferentNames", "")
    let RequiredButNotSpecifiedE () = Message("RequiredButNotSpecified", "%s%s%s")
    let UseOfAddressOfOperatorE () = Message("UseOfAddressOfOperator", "")
    let DefensiveCopyWarningE () = Message("DefensiveCopyWarning", "%s")
    let DeprecatedThreadStaticBindingWarningE () = Message("DeprecatedThreadStaticBindingWarning", "")
    let FunctionValueUnexpectedE () = Message("FunctionValueUnexpected", "%s")
    let UnitTypeExpectedE () = Message("UnitTypeExpected", "%s")
    let UnitTypeExpectedWithEqualityE () = Message("UnitTypeExpectedWithEquality", "%s")
    let UnitTypeExpectedWithPossiblePropertySetterE () = Message("UnitTypeExpectedWithPossiblePropertySetter", "%s%s%s")
    let UnitTypeExpectedWithPossibleAssignmentE () = Message("UnitTypeExpectedWithPossibleAssignment", "%s%s")
    let UnitTypeExpectedWithPossibleAssignmentToMutableE () = Message("UnitTypeExpectedWithPossibleAssignmentToMutable", "%s%s")
    let RecursiveUseCheckedAtRuntimeE () = Message("RecursiveUseCheckedAtRuntime", "")
    let LetRecUnsound1E () = Message("LetRecUnsound1", "%s")
    let LetRecUnsound2E () = Message("LetRecUnsound2", "%s%s")
    let LetRecUnsoundInnerE () = Message("LetRecUnsoundInner", "%s")
    let LetRecEvaluatedOutOfOrderE () = Message("LetRecEvaluatedOutOfOrder", "")
    let LetRecCheckedAtRuntimeE () = Message("LetRecCheckedAtRuntime", "")
    let SelfRefObjCtor1E () = Message("SelfRefObjCtor1", "")
    let SelfRefObjCtor2E () = Message("SelfRefObjCtor2", "")
    let VirtualAugmentationOnNullValuedTypeE () = Message("VirtualAugmentationOnNullValuedType", "")
    let NonVirtualAugmentationOnNullValuedTypeE () = Message("NonVirtualAugmentationOnNullValuedType", "")
    let NonUniqueInferredAbstractSlot1E () = Message("NonUniqueInferredAbstractSlot1", "%s")
    let NonUniqueInferredAbstractSlot2E () = Message("NonUniqueInferredAbstractSlot2", "")
    let NonUniqueInferredAbstractSlot3E () = Message("NonUniqueInferredAbstractSlot3", "%s%s")
    let NonUniqueInferredAbstractSlot4E () = Message("NonUniqueInferredAbstractSlot4", "")
    let Failure3E () = Message("Failure3", "%s")
    let Failure4E () = Message("Failure4", "%s")
    let MatchIncomplete1E () = Message("MatchIncomplete1", "")
    let MatchIncomplete2E () = Message("MatchIncomplete2", "%s")
    let MatchIncomplete3E () = Message("MatchIncomplete3", "%s")
    let MatchIncomplete4E () = Message("MatchIncomplete4", "")
    let RuleNeverMatchedE () = Message("RuleNeverMatched", "")
    let EnumMatchIncomplete1E () = Message("EnumMatchIncomplete1", "")
    let ValNotMutableE () = Message("ValNotMutable", "%s")
    let ValNotLocalE () = Message("ValNotLocal", "")
    let Obsolete1E () = Message("Obsolete1", "")
    let Obsolete2E () = Message("Obsolete2", "%s")
    let ExperimentalE () = Message("Experimental", "%s")
    let PossibleUnverifiableCodeE () = Message("PossibleUnverifiableCode", "")
    let DeprecatedE () = Message("Deprecated", "%s")
    let LibraryUseOnlyE () = Message("LibraryUseOnly", "")
    let MissingFieldsE () = Message("MissingFields", "%s")
    let ValueRestriction1E () = Message("ValueRestriction1", "%s%s%s")
    let ValueRestriction2E () = Message("ValueRestriction2", "%s%s%s")
    let ValueRestriction3E () = Message("ValueRestriction3", "%s")
    let ValueRestriction4E () = Message("ValueRestriction4", "%s%s%s")
    let ValueRestriction5E () = Message("ValueRestriction5", "%s%s%s")
    let RecoverableParseErrorE () = Message("RecoverableParseError", "")
    let ReservedKeywordE () = Message("ReservedKeyword", "%s")
    let IndentationProblemE () = Message("IndentationProblem", "%s")
    let OverrideInIntrinsicAugmentationE () = Message("OverrideInIntrinsicAugmentation", "")
    let OverrideInExtrinsicAugmentationE () = Message("OverrideInExtrinsicAugmentation", "")
    let IntfImplInIntrinsicAugmentationE () = Message("IntfImplInIntrinsicAugmentation", "")
    let IntfImplInExtrinsicAugmentationE () = Message("IntfImplInExtrinsicAugmentation", "")
    let UnresolvedReferenceNoRangeE () = Message("UnresolvedReferenceNoRange", "%s")
    let UnresolvedPathReferenceNoRangeE () = Message("UnresolvedPathReferenceNoRange", "%s%s")
    let HashIncludeNotAllowedInNonScriptE () = Message("HashIncludeNotAllowedInNonScript", "")
    let HashReferenceNotAllowedInNonScriptE () = Message("HashReferenceNotAllowedInNonScript", "")
    let HashDirectiveNotAllowedInNonScriptE () = Message("HashDirectiveNotAllowedInNonScript", "")
    let FileNameNotResolvedE () = Message("FileNameNotResolved", "%s%s")
    let AssemblyNotResolvedE () = Message("AssemblyNotResolved", "%s")
    let HashLoadedSourceHasIssues0E () = Message("HashLoadedSourceHasIssues0", "")
    let HashLoadedSourceHasIssues1E () = Message("HashLoadedSourceHasIssues1", "")
    let HashLoadedSourceHasIssues2E () = Message("HashLoadedSourceHasIssues2", "")
    let HashLoadedScriptConsideredSourceE () = Message("HashLoadedScriptConsideredSource", "")
    let InvalidInternalsVisibleToAssemblyName1E () = Message("InvalidInternalsVisibleToAssemblyName1", "%s%s")
    let InvalidInternalsVisibleToAssemblyName2E () = Message("InvalidInternalsVisibleToAssemblyName2", "%s")
    let LoadedSourceNotFoundIgnoringE () = Message("LoadedSourceNotFoundIgnoring", "%s")
    let MSBuildReferenceResolutionErrorE () = Message("MSBuildReferenceResolutionError", "%s%s")
    let TargetInvocationExceptionWrapperE () = Message("TargetInvocationExceptionWrapper", "%s")
594

D
Don Syme 已提交
595
#if DEBUG
D
Don Syme 已提交
596
let mutable showParserStackOnParseError = false
D
Don Syme 已提交
597
#endif
D
Don Syme 已提交
598

D
Don Syme 已提交
599 600 601 602
let (|InvalidArgument|_|) (exn: exn) =
    match exn with
    | :? ArgumentException as e -> Some e.Message
    | _ -> None
603

604 605 606
let OutputNameSuggestions (os: StringBuilder) suggestNames suggestionsF idText =
    if suggestNames then
        let buffer = DiagnosticResolutionHints.SuggestionBuffer idText
607

608 609
        if not buffer.Disabled then
            suggestionsF buffer.Add
D
Don Syme 已提交
610

611 612 613
            if not buffer.IsEmpty then
                os.AppendString " "
                os.AppendString(FSComp.SR.undefinedNameSuggestionsIntro ())
D
Don Syme 已提交
614

615 616 617 618
                for value in buffer do
                    os.AppendLine() |> ignore
                    os.AppendString "   "
                    os.AppendString(ConvertValLogicalNameToDisplayNameCore value)
D
Don Syme 已提交
619

620 621 622 623 624 625 626 627 628 629 630 631 632 633 634
let OutputTypesNotInEqualityRelationContextInfo contextInfo ty1 ty2 m (os: StringBuilder) fallback =
    match contextInfo with
    | ContextInfo.IfExpression range when equals range m -> os.AppendString(FSComp.SR.ifExpression (ty1, ty2))
    | ContextInfo.CollectionElement (isArray, range) when equals range m ->
        if isArray then
            os.AppendString(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))
    | 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))
    | contextInfo -> fallback contextInfo

635
type Exception with
636

637
    member exn.Output(os: StringBuilder, suggestNames) =
638

639
        match exn with
640 641
        // TODO: this is now unused...?
        | ConstraintSolverTupleDiffLengths (_, _, tl1, tl2, m, m2) ->
D
Don Syme 已提交
642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681
            os.AppendString(ConstraintSolverTupleDiffLengthsE().Format tl1.Length tl2.Length)

            if m.StartLine <> m2.StartLine then
                os.AppendString(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)

            match contextInfo with
            | ContextInfo.ReturnInComputationExpression -> os.AppendString(" " + FSComp.SR.returnUsedInsteadOfReturnBang ())
            | ContextInfo.YieldInComputationExpression -> os.AppendString(" " + FSComp.SR.yieldUsedInsteadOfYieldBang ())
            | _ -> ()

            if m.StartLine <> m2.StartLine then
                os.AppendString(SeeAlsoE().Format(stringOfRange m))

        | ConstraintSolverMissingConstraint (denv, tpr, tpc, m, m2) ->
            os.AppendString(
                ConstraintSolverMissingConstraintE()
                    .Format(NicePrint.stringOfTyparConstraint denv (tpr, tpc))
            )

            if m.StartLine <> m2.StartLine then
                os.AppendString(SeeAlsoE().Format(stringOfRange m))

        | ConstraintSolverTypesNotInEqualityRelation (denv, (TType_measure _ as ty1), (TType_measure _ as 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(ConstraintSolverTypesNotInEqualityRelation1E().Format ty1 ty2)

            if m.StartLine <> m2.StartLine then
                os.AppendString(SeeAlsoE().Format(stringOfRange m))

        | ConstraintSolverTypesNotInEqualityRelation (denv, ty1, ty2, m, m2, contextInfo) ->
            // REVIEW: consider if we need to show _cxs (the type parameter constraints)
            let ty1, ty2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2

682 683
            OutputTypesNotInEqualityRelationContextInfo contextInfo ty1 ty2 m os (fun _ ->
                os.AppendString(ConstraintSolverTypesNotInEqualityRelation2E().Format ty1 ty2))
D
Don Syme 已提交
684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706

            if m.StartLine <> m2.StartLine then
                os.AppendString(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)

            if m.StartLine <> m2.StartLine then
                os.AppendString(SeeAlsoE().Format(stringOfRange m2))

        | ConstraintSolverError (msg, m, m2) ->
            os.AppendString msg

            if m.StartLine <> m2.StartLine then
                os.AppendString(SeeAlsoE().Format(stringOfRange m2))

        | ErrorFromAddingTypeEquation (g, denv, ty1, ty2, ConstraintSolverTypesNotInEqualityRelation (_, ty1b, ty2b, m, _, contextInfo), _) when
            typeEquiv g ty1 ty1b && typeEquiv g ty2 ty2b
            ->
            let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2

707 708 709 710 711 712 713 714 715
            OutputTypesNotInEqualityRelationContextInfo contextInfo ty1 ty2 m os (fun contextInfo ->
                match contextInfo with
                | ContextInfo.TupleInRecordFields ->
                    os.AppendString(ErrorFromAddingTypeEquation1E().Format ty2 ty1 tpcs)
                    os.AppendString(Environment.NewLine + FSComp.SR.commaInsteadOfSemicolonInRecord ())
                | _ when ty2 = "bool" && ty1.EndsWithOrdinal(" ref") ->
                    os.AppendString(ErrorFromAddingTypeEquation1E().Format ty2 ty1 tpcs)
                    os.AppendString(Environment.NewLine + FSComp.SR.derefInsteadOfNot ())
                | _ -> os.AppendString(ErrorFromAddingTypeEquation1E().Format ty2 ty1 tpcs))
D
Don Syme 已提交
716 717 718 719 720 721

        | ErrorFromAddingTypeEquation (_, _, _, _, (ConstraintSolverTypesNotInEqualityRelation (_, _, _, _, _, contextInfo) as e), _) when
            (match contextInfo with
             | ContextInfo.NoContext -> false
             | _ -> true)
            ->
722
            e.Output(os, suggestNames)
D
Don Syme 已提交
723

724 725 726
        | ErrorFromAddingTypeEquation(error = ConstraintSolverTypesNotInSubsumptionRelation _ as e) -> e.Output(os, suggestNames)

        | ErrorFromAddingTypeEquation(error = ConstraintSolverError _ as e) -> e.Output(os, suggestNames)
D
Don Syme 已提交
727

728
        | ErrorFromAddingTypeEquation (_g, denv, ty1, ty2, ConstraintSolverTupleDiffLengths (_, contextInfo, tl1, tl2, _, _), m) ->
729
            let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
730
            let messageArgs = tl1.Length, ty1, tl2.Length, ty2
731 732

            if ty1 <> ty2 + tpcs then
733 734 735 736 737 738 739 740 741 742 743 744
                match contextInfo with
                | ContextInfo.IfExpression range when equals range m -> os.AppendString(FSComp.SR.ifExpressionTuple messageArgs)
                | ContextInfo.ElseBranchResult range when equals range m ->
                    os.AppendString(FSComp.SR.elseBranchHasWrongTypeTuple messageArgs)
                | ContextInfo.FollowingPatternMatchClause range when equals range m ->
                    os.AppendString(FSComp.SR.followingPatternMatchClauseHasWrongTypeTuple messageArgs)
                | ContextInfo.CollectionElement (isArray, range) when equals range m ->
                    if isArray then
                        os.AppendString(FSComp.SR.arrayElementHasWrongTypeTuple messageArgs)
                    else
                        os.AppendString(FSComp.SR.listElementHasWrongTypeTuple messageArgs)
                | _ -> os.AppendString(ErrorFromAddingTypeEquationTuplesE().Format tl1.Length ty1 tl2.Length ty2 tpcs)
745

D
Don Syme 已提交
746 747 748 749 750 751 752
        | ErrorFromAddingTypeEquation (g, denv, ty1, ty2, e, _) ->
            if not (typeEquiv g ty1 ty2) then
                let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2

                if ty1 <> ty2 + tpcs then
                    os.AppendString(ErrorFromAddingTypeEquation2E().Format ty1 ty2 tpcs)

753
            e.Output(os, suggestNames)
D
Don Syme 已提交
754 755 756 757

        | ErrorFromApplyingDefault (_, denv, _, defaultType, e, _) ->
            let defaultType = NicePrint.minimalStringOfType denv defaultType
            os.AppendString(ErrorFromApplyingDefault1E().Format defaultType)
758
            e.Output(os, suggestNames)
D
Don Syme 已提交
759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776
            os.AppendString(ErrorFromApplyingDefault2E().Format)

        | ErrorsFromAddingSubsumptionConstraint (g, denv, ty1, ty2, e, contextInfo, _) ->
            match contextInfo with
            | ContextInfo.DowncastUsedInsteadOfUpcast isOperator ->
                let ty1, ty2, _ = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2

                if isOperator then
                    os.AppendString(FSComp.SR.considerUpcastOperator (ty1, ty2) |> snd)
                else
                    os.AppendString(FSComp.SR.considerUpcast (ty1, ty2) |> snd)
            | _ ->
                if not (typeEquiv g ty1 ty2) then
                    let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2

                    if ty1 <> (ty2 + tpcs) then
                        os.AppendString(ErrorsFromAddingSubsumptionConstraintE().Format ty2 ty1 tpcs)
                    else
777
                        e.Output(os, suggestNames)
D
Don Syme 已提交
778
                else
779
                    e.Output(os, suggestNames)
D
Don Syme 已提交
780 781 782 783 784

        | UpperCaseIdentifierInPattern _ -> os.AppendString(UpperCaseIdentifierInPatternE().Format)

        | NotUpperCaseConstructor _ -> os.AppendString(NotUpperCaseConstructorE().Format)

785 786
        | NotUpperCaseConstructorWithoutRQA _ -> os.AppendString(NotUpperCaseConstructorWithoutRQAE().Format)

787
        | ErrorFromAddingConstraint (_, e, _) -> e.Output(os, suggestNames)
788

789
#if !NO_TYPEPROVIDERS
D
Don Syme 已提交
790
        | TypeProviders.ProvidedTypeResolutionNoRange e
791

792
        | TypeProviders.ProvidedTypeResolution (_, e) -> e.Output(os, suggestNames)
793

D
Don Syme 已提交
794
        | :? TypeProviderError as e -> os.AppendString(e.ContextualErrorMessage)
795 796
#endif

D
Don Syme 已提交
797 798
        | UnresolvedOverloading (denv, callerArgs, failure, m) ->

799
            let g = denv.g
D
Don Syme 已提交
800 801 802 803 804
            // extract eventual information (return type and type parameters)
            // from ConstraintTraitInfo
            let knownReturnType, genericParameterTypes =
                match failure with
                | NoOverloadsFound(cx = Some cx)
805
                | PossibleCandidates(cx = Some cx) -> Some(cx.GetReturnType(g)), cx.GetCompiledArgumentTypes()
D
Don Syme 已提交
806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911
                | _ -> None, []

            // prepare message parts (known arguments, known return type, known generic parameters)
            let argsMessage, returnType, genericParametersMessage =

                let retTy =
                    knownReturnType |> Option.defaultValue (TType_var(Typar.NewUnlinked(), 0uy))

                let argRepr =
                    callerArgs.ArgumentNamesAndTypes
                    |> List.map (fun (name, tTy) ->
                        tTy,
                        {
                            ArgReprInfo.Name = name |> Option.map (fun name -> Ident(name, range.Zero))
                            ArgReprInfo.Attribs = []
                        })

                let argsL, retTyL, genParamTysL =
                    NicePrint.prettyLayoutsOfUnresolvedOverloading denv argRepr retTy genericParameterTypes

                match callerArgs.ArgumentNamesAndTypes with
                | [] -> None, LayoutRender.showL retTyL, LayoutRender.showL genParamTysL
                | items ->
                    let args = LayoutRender.showL argsL

                    let prefixMessage =
                        match items with
                        | [ _ ] -> FSComp.SR.csNoOverloadsFoundArgumentsPrefixSingular
                        | _ -> FSComp.SR.csNoOverloadsFoundArgumentsPrefixPlural

                    Some(prefixMessage args), LayoutRender.showL retTyL, LayoutRender.showL genParamTysL

            let knownReturnType =
                match knownReturnType with
                | None -> None
                | Some _ -> Some(FSComp.SR.csNoOverloadsFoundReturnType returnType)

            let genericParametersMessage =
                match genericParameterTypes with
                | [] -> None
                | [ _ ] -> Some(FSComp.SR.csNoOverloadsFoundTypeParametersPrefixSingular genericParametersMessage)
                | _ -> Some(FSComp.SR.csNoOverloadsFoundTypeParametersPrefixPlural genericParametersMessage)

            let overloadMethodInfo displayEnv m (x: OverloadInformation) =
                let paramInfo =
                    match x.error with
                    | :? ArgDoesNotMatchError as x ->
                        let nameOrOneBasedIndexMessage =
                            x.calledArg.NameOpt
                            |> Option.map (fun n -> FSComp.SR.csOverloadCandidateNamedArgumentTypeMismatch n.idText)
                            |> Option.defaultValue (
                                FSComp.SR.csOverloadCandidateIndexedArgumentTypeMismatch ((vsnd x.calledArg.Position) + 1)
                            ) //snd

                        sprintf " // %s" nameOrOneBasedIndexMessage
                    | _ -> ""

                (NicePrint.stringOfMethInfo 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.map FSComp.SR.formatDashItem
                |> String.concat nl

            // assemble final message composing the parts
            let msg =
                let optionalParts =
                    [ knownReturnType; genericParametersMessage; argsMessage ]
                    |> List.choose id
                    |> String.concat (nl + nl)
                    |> function
                        | "" -> nl
                        | result -> nl + nl + result + nl + nl

                match failure with
                | NoOverloadsFound (methodName, overloads, _) ->
                    FSComp.SR.csNoOverloadsFound methodName
                    + optionalParts
                    + (FSComp.SR.csAvailableOverloads (formatOverloads overloads))
                | PossibleCandidates (methodName, [], _) -> FSComp.SR.csMethodIsOverloaded methodName
                | PossibleCandidates (methodName, overloads, _) ->
                    FSComp.SR.csMethodIsOverloaded methodName
                    + optionalParts
                    + FSComp.SR.csCandidates (formatOverloads overloads)

            os.AppendString msg

        | UnresolvedConversionOperator (denv, fromTy, toTy, _) ->
            let ty1, ty2, _tpcs = NicePrint.minimalStringsOfTwoTypes denv fromTy toTy
            os.AppendString(FSComp.SR.csTypeDoesNotSupportConversion (ty1, ty2))

        | FunctionExpected _ -> os.AppendString(FunctionExpectedE().Format)

        | BakedInMemberConstraintName (nm, _) -> os.AppendString(BakedInMemberConstraintNameE().Format nm)

        | StandardOperatorRedefinitionWarning (msg, _) -> os.AppendString msg

        | BadEventTransformation _ -> os.AppendString(BadEventTransformationE().Format)

        | ParameterlessStructCtor _ -> os.AppendString(ParameterlessStructCtorE().Format)

D
Don Syme 已提交
912 913
        | InterfaceNotRevealed (denv, intfTy, _) ->
            os.AppendString(InterfaceNotRevealedE().Format(NicePrint.minimalStringOfType denv intfTy))
D
Don Syme 已提交
914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948

        | NotAFunctionButIndexer (_, _, name, _, _, old) ->
            if old then
                match name with
                | Some name -> os.AppendString(FSComp.SR.notAFunctionButMaybeIndexerWithName name)
                | _ -> os.AppendString(FSComp.SR.notAFunctionButMaybeIndexer ())
            else
                match name with
                | Some name -> os.AppendString(FSComp.SR.notAFunctionButMaybeIndexerWithName2 name)
                | _ -> os.AppendString(FSComp.SR.notAFunctionButMaybeIndexer2 ())

        | NotAFunction (_, _, _, marg) ->
            if marg.StartColumn = 0 then
                os.AppendString(FSComp.SR.notAFunctionButMaybeDeclaration ())
            else
                os.AppendString(FSComp.SR.notAFunction ())

        | TyconBadArgs (_, tcref, d, _) ->
            let exp = tcref.TyparsNoRange.Length

            if exp = 0 then
                os.AppendString(FSComp.SR.buildUnexpectedTypeArgs (fullDisplayTextOfTyconRef tcref, d))
            else
                os.AppendString(TyconBadArgsE().Format (fullDisplayTextOfTyconRef tcref) exp d)

        | IndeterminateType _ -> os.AppendString(IndeterminateTypeE().Format)

        | NameClash (nm, k1, nm1, _, k2, nm2, _) ->
            if nm = nm1 && nm1 = nm2 && k1 = k2 then
                os.AppendString(NameClash1E().Format k1 nm1)
            else
                os.AppendString(NameClash2E().Format k1 nm1 nm k2 nm2)

        | Duplicate (k, s, _) ->
            if k = "member" then
949
                os.AppendString(Duplicate1E().Format(ConvertValLogicalNameToDisplayNameCore s))
D
Don Syme 已提交
950
            else
951
                os.AppendString(Duplicate2E().Format k (ConvertValLogicalNameToDisplayNameCore s))
D
Don Syme 已提交
952 953

        | UndefinedName (_, k, id, suggestionsF) ->
954
            os.AppendString(k (ConvertValLogicalNameToDisplayNameCore id.idText))
955
            OutputNameSuggestions os suggestNames suggestionsF id.idText
D
Don Syme 已提交
956 957 958 959 960 961 962 963 964 965

        | InternalUndefinedItemRef (f, smr, ccuName, s) ->
            let _, errs = f (smr, ccuName, s)
            os.AppendString errs

        | FieldNotMutable _ -> os.AppendString(FieldNotMutableE().Format)

        | FieldsFromDifferentTypes (_, fref1, fref2, _) ->
            os.AppendString(FieldsFromDifferentTypesE().Format fref1.FieldName fref2.FieldName)

966
        | VarBoundTwice id -> os.AppendString(VarBoundTwiceE().Format(ConvertValLogicalNameToDisplayNameCore id.idText))
D
Don Syme 已提交
967 968 969

        | Recursion (denv, id, ty1, ty2, _) ->
            let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
970
            os.AppendString(RecursionE().Format (ConvertValLogicalNameToDisplayNameCore id.idText) ty1 ty2 tpcs)
D
Don Syme 已提交
971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018

        | InvalidRuntimeCoercion (denv, ty1, ty2, _) ->
            let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
            os.AppendString(InvalidRuntimeCoercionE().Format ty1 ty2 tpcs)

        | IndeterminateRuntimeCoercion (denv, ty1, ty2, _) ->
            let ty1, ty2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
            os.AppendString(IndeterminateRuntimeCoercionE().Format 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)

        | 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)

        | TypeIsImplicitlyAbstract _ -> os.AppendString(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)

            match tpnmOpt with
            | None -> os.AppendString(NonRigidTypar1E().Format (stringOfRange typarRange) (NicePrint.stringOfTy denv ty2))
            | Some tpnm ->
                match ty1 with
                | TType_measure _ -> os.AppendString(NonRigidTypar2E().Format tpnm (NicePrint.stringOfTy denv ty2))
                | _ -> os.AppendString(NonRigidTypar3E().Format tpnm (NicePrint.stringOfTy denv ty2))

        | SyntaxError (ctxt, _) ->
            let ctxt = unbox<Parsing.ParseErrorContext<Parser.token>> (ctxt)

            let (|EndOfStructuredConstructToken|_|) token =
                match token with
                | Parser.TOKEN_ODECLEND
                | Parser.TOKEN_OBLOCKSEP
                | Parser.TOKEN_OEND
                | Parser.TOKEN_ORIGHT_BLOCK_END
                | Parser.TOKEN_OBLOCKEND
                | Parser.TOKEN_OBLOCKEND_COMING_SOON
                | Parser.TOKEN_OBLOCKEND_IS_HERE -> Some()
                | _ -> None

            let tokenIdToText tid =
                match tid with
1019
                | Parser.TOKEN_IDENT -> SR.GetString("Parser.TOKEN.IDENT")
D
Don Syme 已提交
1020 1021 1022 1023 1024 1025 1026 1027 1028 1029
                | Parser.TOKEN_BIGNUM
                | Parser.TOKEN_INT8
                | Parser.TOKEN_UINT8
                | Parser.TOKEN_INT16
                | Parser.TOKEN_UINT16
                | Parser.TOKEN_INT32
                | Parser.TOKEN_UINT32
                | Parser.TOKEN_INT64
                | Parser.TOKEN_UINT64
                | Parser.TOKEN_UNATIVEINT
1030
                | Parser.TOKEN_NATIVEINT -> SR.GetString("Parser.TOKEN.INT")
D
Don Syme 已提交
1031
                | Parser.TOKEN_IEEE32
1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080
                | Parser.TOKEN_IEEE64 -> SR.GetString("Parser.TOKEN.FLOAT")
                | Parser.TOKEN_DECIMAL -> SR.GetString("Parser.TOKEN.DECIMAL")
                | Parser.TOKEN_CHAR -> SR.GetString("Parser.TOKEN.CHAR")

                | Parser.TOKEN_BASE -> SR.GetString("Parser.TOKEN.BASE")
                | Parser.TOKEN_LPAREN_STAR_RPAREN -> SR.GetString("Parser.TOKEN.LPAREN.STAR.RPAREN")
                | Parser.TOKEN_DOLLAR -> SR.GetString("Parser.TOKEN.DOLLAR")
                | Parser.TOKEN_INFIX_STAR_STAR_OP -> SR.GetString("Parser.TOKEN.INFIX.STAR.STAR.OP")
                | Parser.TOKEN_INFIX_COMPARE_OP -> SR.GetString("Parser.TOKEN.INFIX.COMPARE.OP")
                | Parser.TOKEN_COLON_GREATER -> SR.GetString("Parser.TOKEN.COLON.GREATER")
                | Parser.TOKEN_COLON_COLON -> SR.GetString("Parser.TOKEN.COLON.COLON")
                | Parser.TOKEN_PERCENT_OP -> SR.GetString("Parser.TOKEN.PERCENT.OP")
                | Parser.TOKEN_INFIX_AT_HAT_OP -> SR.GetString("Parser.TOKEN.INFIX.AT.HAT.OP")
                | Parser.TOKEN_INFIX_BAR_OP -> SR.GetString("Parser.TOKEN.INFIX.BAR.OP")
                | Parser.TOKEN_PLUS_MINUS_OP -> SR.GetString("Parser.TOKEN.PLUS.MINUS.OP")
                | Parser.TOKEN_PREFIX_OP -> SR.GetString("Parser.TOKEN.PREFIX.OP")
                | Parser.TOKEN_COLON_QMARK_GREATER -> SR.GetString("Parser.TOKEN.COLON.QMARK.GREATER")
                | Parser.TOKEN_INFIX_STAR_DIV_MOD_OP -> SR.GetString("Parser.TOKEN.INFIX.STAR.DIV.MOD.OP")
                | Parser.TOKEN_INFIX_AMP_OP -> SR.GetString("Parser.TOKEN.INFIX.AMP.OP")
                | Parser.TOKEN_AMP -> SR.GetString("Parser.TOKEN.AMP")
                | Parser.TOKEN_AMP_AMP -> SR.GetString("Parser.TOKEN.AMP.AMP")
                | Parser.TOKEN_BAR_BAR -> SR.GetString("Parser.TOKEN.BAR.BAR")
                | Parser.TOKEN_LESS -> SR.GetString("Parser.TOKEN.LESS")
                | Parser.TOKEN_GREATER -> SR.GetString("Parser.TOKEN.GREATER")
                | Parser.TOKEN_QMARK -> SR.GetString("Parser.TOKEN.QMARK")
                | Parser.TOKEN_QMARK_QMARK -> SR.GetString("Parser.TOKEN.QMARK.QMARK")
                | Parser.TOKEN_COLON_QMARK -> SR.GetString("Parser.TOKEN.COLON.QMARK")
                | Parser.TOKEN_INT32_DOT_DOT -> SR.GetString("Parser.TOKEN.INT32.DOT.DOT")
                | Parser.TOKEN_DOT_DOT -> SR.GetString("Parser.TOKEN.DOT.DOT")
                | Parser.TOKEN_DOT_DOT_HAT -> SR.GetString("Parser.TOKEN.DOT.DOT")
                | Parser.TOKEN_QUOTE -> SR.GetString("Parser.TOKEN.QUOTE")
                | Parser.TOKEN_STAR -> SR.GetString("Parser.TOKEN.STAR")
                | Parser.TOKEN_HIGH_PRECEDENCE_TYAPP -> SR.GetString("Parser.TOKEN.HIGH.PRECEDENCE.TYAPP")
                | Parser.TOKEN_COLON -> SR.GetString("Parser.TOKEN.COLON")
                | Parser.TOKEN_COLON_EQUALS -> SR.GetString("Parser.TOKEN.COLON.EQUALS")
                | Parser.TOKEN_LARROW -> SR.GetString("Parser.TOKEN.LARROW")
                | Parser.TOKEN_EQUALS -> SR.GetString("Parser.TOKEN.EQUALS")
                | Parser.TOKEN_GREATER_BAR_RBRACK -> SR.GetString("Parser.TOKEN.GREATER.BAR.RBRACK")
                | Parser.TOKEN_MINUS -> SR.GetString("Parser.TOKEN.MINUS")
                | Parser.TOKEN_ADJACENT_PREFIX_OP -> SR.GetString("Parser.TOKEN.ADJACENT.PREFIX.OP")
                | Parser.TOKEN_FUNKY_OPERATOR_NAME -> SR.GetString("Parser.TOKEN.FUNKY.OPERATOR.NAME")
                | Parser.TOKEN_COMMA -> SR.GetString("Parser.TOKEN.COMMA")
                | Parser.TOKEN_DOT -> SR.GetString("Parser.TOKEN.DOT")
                | Parser.TOKEN_BAR -> SR.GetString("Parser.TOKEN.BAR")
                | Parser.TOKEN_HASH -> SR.GetString("Parser.TOKEN.HASH")
                | Parser.TOKEN_UNDERSCORE -> SR.GetString("Parser.TOKEN.UNDERSCORE")
                | Parser.TOKEN_SEMICOLON -> SR.GetString("Parser.TOKEN.SEMICOLON")
                | Parser.TOKEN_SEMICOLON_SEMICOLON -> SR.GetString("Parser.TOKEN.SEMICOLON.SEMICOLON")
                | Parser.TOKEN_LPAREN -> SR.GetString("Parser.TOKEN.LPAREN")
D
Don Syme 已提交
1081 1082
                | Parser.TOKEN_RPAREN
                | Parser.TOKEN_RPAREN_COMING_SOON
1083 1084 1085 1086 1087 1088 1089 1090 1091 1092
                | Parser.TOKEN_RPAREN_IS_HERE -> SR.GetString("Parser.TOKEN.RPAREN")
                | Parser.TOKEN_LQUOTE -> SR.GetString("Parser.TOKEN.LQUOTE")
                | Parser.TOKEN_LBRACK -> SR.GetString("Parser.TOKEN.LBRACK")
                | Parser.TOKEN_LBRACE_BAR -> SR.GetString("Parser.TOKEN.LBRACE.BAR")
                | Parser.TOKEN_LBRACK_BAR -> SR.GetString("Parser.TOKEN.LBRACK.BAR")
                | Parser.TOKEN_LBRACK_LESS -> SR.GetString("Parser.TOKEN.LBRACK.LESS")
                | Parser.TOKEN_LBRACE -> SR.GetString("Parser.TOKEN.LBRACE")
                | Parser.TOKEN_BAR_RBRACK -> SR.GetString("Parser.TOKEN.BAR.RBRACK")
                | Parser.TOKEN_BAR_RBRACE -> SR.GetString("Parser.TOKEN.BAR.RBRACE")
                | Parser.TOKEN_GREATER_RBRACK -> SR.GetString("Parser.TOKEN.GREATER.RBRACK")
1093
                | Parser.TOKEN_RQUOTE_DOT
1094 1095
                | Parser.TOKEN_RQUOTE -> SR.GetString("Parser.TOKEN.RQUOTE")
                | Parser.TOKEN_RBRACK -> SR.GetString("Parser.TOKEN.RBRACK")
D
Don Syme 已提交
1096 1097
                | Parser.TOKEN_RBRACE
                | Parser.TOKEN_RBRACE_COMING_SOON
1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115
                | Parser.TOKEN_RBRACE_IS_HERE -> SR.GetString("Parser.TOKEN.RBRACE")
                | Parser.TOKEN_PUBLIC -> SR.GetString("Parser.TOKEN.PUBLIC")
                | Parser.TOKEN_PRIVATE -> SR.GetString("Parser.TOKEN.PRIVATE")
                | Parser.TOKEN_INTERNAL -> SR.GetString("Parser.TOKEN.INTERNAL")
                | Parser.TOKEN_CONSTRAINT -> SR.GetString("Parser.TOKEN.CONSTRAINT")
                | Parser.TOKEN_INSTANCE -> SR.GetString("Parser.TOKEN.INSTANCE")
                | Parser.TOKEN_DELEGATE -> SR.GetString("Parser.TOKEN.DELEGATE")
                | Parser.TOKEN_INHERIT -> SR.GetString("Parser.TOKEN.INHERIT")
                | Parser.TOKEN_CONSTRUCTOR -> SR.GetString("Parser.TOKEN.CONSTRUCTOR")
                | Parser.TOKEN_DEFAULT -> SR.GetString("Parser.TOKEN.DEFAULT")
                | Parser.TOKEN_OVERRIDE -> SR.GetString("Parser.TOKEN.OVERRIDE")
                | Parser.TOKEN_ABSTRACT -> SR.GetString("Parser.TOKEN.ABSTRACT")
                | Parser.TOKEN_CLASS -> SR.GetString("Parser.TOKEN.CLASS")
                | Parser.TOKEN_MEMBER -> SR.GetString("Parser.TOKEN.MEMBER")
                | Parser.TOKEN_STATIC -> SR.GetString("Parser.TOKEN.STATIC")
                | Parser.TOKEN_NAMESPACE -> SR.GetString("Parser.TOKEN.NAMESPACE")
                | Parser.TOKEN_OBLOCKBEGIN -> SR.GetString("Parser.TOKEN.OBLOCKBEGIN")
                | EndOfStructuredConstructToken -> SR.GetString("Parser.TOKEN.OBLOCKEND")
D
Don Syme 已提交
1116
                | Parser.TOKEN_THEN
1117
                | Parser.TOKEN_OTHEN -> SR.GetString("Parser.TOKEN.OTHEN")
D
Don Syme 已提交
1118
                | Parser.TOKEN_ELSE
1119
                | Parser.TOKEN_OELSE -> SR.GetString("Parser.TOKEN.OELSE")
1120 1121
                | Parser.TOKEN_LET
                | Parser.TOKEN_OLET -> SR.GetString("Parser.TOKEN.OLET")
D
Don Syme 已提交
1122
                | Parser.TOKEN_OBINDER
1123
                | Parser.TOKEN_BINDER -> SR.GetString("Parser.TOKEN.BINDER")
D
Don Syme 已提交
1124
                | Parser.TOKEN_OAND_BANG
1125 1126 1127 1128 1129 1130 1131
                | Parser.TOKEN_AND_BANG -> SR.GetString("Parser.TOKEN.AND.BANG")
                | Parser.TOKEN_ODO -> SR.GetString("Parser.TOKEN.ODO")
                | Parser.TOKEN_OWITH -> SR.GetString("Parser.TOKEN.OWITH")
                | Parser.TOKEN_OFUNCTION -> SR.GetString("Parser.TOKEN.OFUNCTION")
                | Parser.TOKEN_OFUN -> SR.GetString("Parser.TOKEN.OFUN")
                | Parser.TOKEN_ORESET -> SR.GetString("Parser.TOKEN.ORESET")
                | Parser.TOKEN_ODUMMY -> SR.GetString("Parser.TOKEN.ODUMMY")
D
Don Syme 已提交
1132
                | Parser.TOKEN_DO_BANG
1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144
                | Parser.TOKEN_ODO_BANG -> SR.GetString("Parser.TOKEN.ODO.BANG")
                | Parser.TOKEN_YIELD -> SR.GetString("Parser.TOKEN.YIELD")
                | Parser.TOKEN_YIELD_BANG -> SR.GetString("Parser.TOKEN.YIELD.BANG")
                | Parser.TOKEN_OINTERFACE_MEMBER -> SR.GetString("Parser.TOKEN.OINTERFACE.MEMBER")
                | Parser.TOKEN_ELIF -> SR.GetString("Parser.TOKEN.ELIF")
                | Parser.TOKEN_RARROW -> SR.GetString("Parser.TOKEN.RARROW")
                | Parser.TOKEN_SIG -> SR.GetString("Parser.TOKEN.SIG")
                | Parser.TOKEN_STRUCT -> SR.GetString("Parser.TOKEN.STRUCT")
                | Parser.TOKEN_UPCAST -> SR.GetString("Parser.TOKEN.UPCAST")
                | Parser.TOKEN_DOWNCAST -> SR.GetString("Parser.TOKEN.DOWNCAST")
                | Parser.TOKEN_NULL -> SR.GetString("Parser.TOKEN.NULL")
                | Parser.TOKEN_RESERVED -> SR.GetString("Parser.TOKEN.RESERVED")
D
Don Syme 已提交
1145 1146
                | Parser.TOKEN_MODULE
                | Parser.TOKEN_MODULE_COMING_SOON
1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175
                | Parser.TOKEN_MODULE_IS_HERE -> SR.GetString("Parser.TOKEN.MODULE")
                | Parser.TOKEN_AND -> SR.GetString("Parser.TOKEN.AND")
                | Parser.TOKEN_AS -> SR.GetString("Parser.TOKEN.AS")
                | Parser.TOKEN_ASSERT -> SR.GetString("Parser.TOKEN.ASSERT")
                | Parser.TOKEN_OASSERT -> SR.GetString("Parser.TOKEN.ASSERT")
                | Parser.TOKEN_ASR -> SR.GetString("Parser.TOKEN.ASR")
                | Parser.TOKEN_DOWNTO -> SR.GetString("Parser.TOKEN.DOWNTO")
                | Parser.TOKEN_EXCEPTION -> SR.GetString("Parser.TOKEN.EXCEPTION")
                | Parser.TOKEN_FALSE -> SR.GetString("Parser.TOKEN.FALSE")
                | Parser.TOKEN_FOR -> SR.GetString("Parser.TOKEN.FOR")
                | Parser.TOKEN_FUN -> SR.GetString("Parser.TOKEN.FUN")
                | Parser.TOKEN_FUNCTION -> SR.GetString("Parser.TOKEN.FUNCTION")
                | Parser.TOKEN_FINALLY -> SR.GetString("Parser.TOKEN.FINALLY")
                | Parser.TOKEN_LAZY -> SR.GetString("Parser.TOKEN.LAZY")
                | Parser.TOKEN_OLAZY -> SR.GetString("Parser.TOKEN.LAZY")
                | Parser.TOKEN_MATCH -> SR.GetString("Parser.TOKEN.MATCH")
                | Parser.TOKEN_MATCH_BANG -> SR.GetString("Parser.TOKEN.MATCH.BANG")
                | Parser.TOKEN_MUTABLE -> SR.GetString("Parser.TOKEN.MUTABLE")
                | Parser.TOKEN_NEW -> SR.GetString("Parser.TOKEN.NEW")
                | Parser.TOKEN_OF -> SR.GetString("Parser.TOKEN.OF")
                | Parser.TOKEN_OPEN -> SR.GetString("Parser.TOKEN.OPEN")
                | Parser.TOKEN_OR -> SR.GetString("Parser.TOKEN.OR")
                | Parser.TOKEN_VOID -> SR.GetString("Parser.TOKEN.VOID")
                | Parser.TOKEN_EXTERN -> SR.GetString("Parser.TOKEN.EXTERN")
                | Parser.TOKEN_INTERFACE -> SR.GetString("Parser.TOKEN.INTERFACE")
                | Parser.TOKEN_REC -> SR.GetString("Parser.TOKEN.REC")
                | Parser.TOKEN_TO -> SR.GetString("Parser.TOKEN.TO")
                | Parser.TOKEN_TRUE -> SR.GetString("Parser.TOKEN.TRUE")
                | Parser.TOKEN_TRY -> SR.GetString("Parser.TOKEN.TRY")
D
Don Syme 已提交
1176 1177
                | Parser.TOKEN_TYPE
                | Parser.TOKEN_TYPE_COMING_SOON
1178 1179 1180 1181 1182 1183 1184 1185 1186 1187
                | Parser.TOKEN_TYPE_IS_HERE -> SR.GetString("Parser.TOKEN.TYPE")
                | Parser.TOKEN_VAL -> SR.GetString("Parser.TOKEN.VAL")
                | Parser.TOKEN_INLINE -> SR.GetString("Parser.TOKEN.INLINE")
                | Parser.TOKEN_WHEN -> SR.GetString("Parser.TOKEN.WHEN")
                | Parser.TOKEN_WHILE -> SR.GetString("Parser.TOKEN.WHILE")
                | Parser.TOKEN_WITH -> SR.GetString("Parser.TOKEN.WITH")
                | Parser.TOKEN_IF -> SR.GetString("Parser.TOKEN.IF")
                | Parser.TOKEN_DO -> SR.GetString("Parser.TOKEN.DO")
                | Parser.TOKEN_GLOBAL -> SR.GetString("Parser.TOKEN.GLOBAL")
                | Parser.TOKEN_DONE -> SR.GetString("Parser.TOKEN.DONE")
D
Don Syme 已提交
1188
                | Parser.TOKEN_IN
1189 1190 1191 1192 1193
                | Parser.TOKEN_JOIN_IN -> SR.GetString("Parser.TOKEN.IN")
                | Parser.TOKEN_HIGH_PRECEDENCE_PAREN_APP -> SR.GetString("Parser.TOKEN.HIGH.PRECEDENCE.PAREN.APP")
                | Parser.TOKEN_HIGH_PRECEDENCE_BRACK_APP -> SR.GetString("Parser.TOKEN.HIGH.PRECEDENCE.BRACK.APP")
                | Parser.TOKEN_BEGIN -> SR.GetString("Parser.TOKEN.BEGIN")
                | Parser.TOKEN_END -> SR.GetString("Parser.TOKEN.END")
D
Don Syme 已提交
1194 1195 1196 1197
                | Parser.TOKEN_HASH_LIGHT
                | Parser.TOKEN_HASH_LINE
                | Parser.TOKEN_HASH_IF
                | Parser.TOKEN_HASH_ELSE
1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214
                | Parser.TOKEN_HASH_ENDIF -> SR.GetString("Parser.TOKEN.HASH.ENDIF")
                | Parser.TOKEN_INACTIVECODE -> SR.GetString("Parser.TOKEN.INACTIVECODE")
                | Parser.TOKEN_LEX_FAILURE -> SR.GetString("Parser.TOKEN.LEX.FAILURE")
                | Parser.TOKEN_WHITESPACE -> SR.GetString("Parser.TOKEN.WHITESPACE")
                | Parser.TOKEN_COMMENT -> SR.GetString("Parser.TOKEN.COMMENT")
                | Parser.TOKEN_LINE_COMMENT -> SR.GetString("Parser.TOKEN.LINE.COMMENT")
                | Parser.TOKEN_STRING_TEXT -> SR.GetString("Parser.TOKEN.STRING.TEXT")
                | Parser.TOKEN_BYTEARRAY -> SR.GetString("Parser.TOKEN.BYTEARRAY")
                | Parser.TOKEN_STRING -> SR.GetString("Parser.TOKEN.STRING")
                | Parser.TOKEN_KEYWORD_STRING -> SR.GetString("Parser.TOKEN.KEYWORD_STRING")
                | Parser.TOKEN_EOF -> SR.GetString("Parser.TOKEN.EOF")
                | Parser.TOKEN_CONST -> SR.GetString("Parser.TOKEN.CONST")
                | Parser.TOKEN_FIXED -> SR.GetString("Parser.TOKEN.FIXED")
                | Parser.TOKEN_INTERP_STRING_BEGIN_END -> SR.GetString("Parser.TOKEN.INTERP.STRING.BEGIN.END")
                | Parser.TOKEN_INTERP_STRING_BEGIN_PART -> SR.GetString("Parser.TOKEN.INTERP.STRING.BEGIN.PART")
                | Parser.TOKEN_INTERP_STRING_PART -> SR.GetString("Parser.TOKEN.INTERP.STRING.PART")
                | Parser.TOKEN_INTERP_STRING_END -> SR.GetString("Parser.TOKEN.INTERP.STRING.END")
D
Don Syme 已提交
1215 1216 1217 1218 1219
                | unknown ->
                    Debug.Assert(false, "unknown token tag")
                    let result = sprintf "%+A" unknown
                    Debug.Assert(false, result)
                    result
1220

D
Don Syme 已提交
1221
#if DEBUG
D
Don Syme 已提交
1222 1223 1224
            if showParserStackOnParseError then
                printfn "parser stack:"

1225 1226 1227 1228 1229
                let rps =
                    ctxt.ReducibleProductions
                    |> List.map (fun rps -> rps |> List.map (fun rp -> rp, Parser.prodIdxToNonTerminal rp))

                for rps in rps do
D
Don Syme 已提交
1230 1231
                    printfn "   ----"
                    //printfn "   state %d" state
1232 1233
                    for rp, nonTerminalId in rps do
                        printfn $"       non-terminal %+A{nonTerminalId} (idx {rp}): ... "
D
Don Syme 已提交
1234
#endif
D
Don Syme 已提交
1235

D
Don Syme 已提交
1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436 1437 1438 1439 1440 1441
            match ctxt.CurrentToken with
            | None -> os.AppendString(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))

                // Search for a state producing a single recognized non-terminal in the states on the stack
                let foundInContext =

                    // Merge a bunch of expression non terminals
                    let (|NONTERM_Category_Expr|_|) nonTerminal =
                        match nonTerminal with
                        | Parser.NONTERM_argExpr
                        | Parser.NONTERM_minusExpr
                        | Parser.NONTERM_parenExpr
                        | Parser.NONTERM_atomicExpr
                        | Parser.NONTERM_appExpr
                        | Parser.NONTERM_tupleExpr
                        | Parser.NONTERM_declExpr
                        | Parser.NONTERM_braceExpr
                        | Parser.NONTERM_braceBarExpr
                        | Parser.NONTERM_typedSequentialExprBlock
                        | Parser.NONTERM_interactiveExpr -> Some()
                        | _ -> None

                    // Merge a bunch of pattern non terminals
                    let (|NONTERM_Category_Pattern|_|) nonTerminal =
                        match nonTerminal with
                        | Parser.NONTERM_constrPattern
                        | Parser.NONTERM_parenPattern
                        | Parser.NONTERM_atomicPattern -> Some()
                        | _ -> None

                    // Merge a bunch of if/then/else non terminals
                    let (|NONTERM_Category_IfThenElse|_|) nonTerminal =
                        match nonTerminal with
                        | Parser.NONTERM_ifExprThen
                        | Parser.NONTERM_ifExprElifs
                        | Parser.NONTERM_ifExprCases -> Some()
                        | _ -> None

                    // Merge a bunch of non terminals
                    let (|NONTERM_Category_SignatureFile|_|) nonTerminal =
                        match nonTerminal with
                        | Parser.NONTERM_signatureFile
                        | Parser.NONTERM_moduleSpfn
                        | Parser.NONTERM_moduleSpfns -> Some()
                        | _ -> None

                    let (|NONTERM_Category_ImplementationFile|_|) nonTerminal =
                        match nonTerminal with
                        | Parser.NONTERM_implementationFile
                        | Parser.NONTERM_fileNamespaceImpl
                        | Parser.NONTERM_fileNamespaceImpls -> Some()
                        | _ -> None

                    let (|NONTERM_Category_Definition|_|) nonTerminal =
                        match nonTerminal with
                        | Parser.NONTERM_fileModuleImpl
                        | Parser.NONTERM_moduleDefn
                        | Parser.NONTERM_interactiveDefns
                        | Parser.NONTERM_moduleDefns
                        | Parser.NONTERM_moduleDefnsOrExpr -> Some()
                        | _ -> None

                    let (|NONTERM_Category_Type|_|) nonTerminal =
                        match nonTerminal with
                        | Parser.NONTERM_typ
                        | Parser.NONTERM_tupleType -> Some()
                        | _ -> None

                    let (|NONTERM_Category_Interaction|_|) nonTerminal =
                        match nonTerminal with
                        | Parser.NONTERM_interactiveItemsTerminator
                        | Parser.NONTERM_interaction
                        | Parser.NONTERM__startinteraction -> Some()
                        | _ -> None

                    // Canonicalize the categories and check for a unique category
                    ctxt.ReducibleProductions
                    |> List.exists (fun prods ->
                        let prodIds =
                            prods
                            |> List.map Parser.prodIdxToNonTerminal
                            |> List.map (fun nonTerminal ->
                                match nonTerminal with
                                | NONTERM_Category_Type -> Parser.NONTERM_typ
                                | NONTERM_Category_Expr -> Parser.NONTERM_declExpr
                                | NONTERM_Category_Pattern -> Parser.NONTERM_atomicPattern
                                | NONTERM_Category_IfThenElse -> Parser.NONTERM_ifExprThen
                                | NONTERM_Category_SignatureFile -> Parser.NONTERM_signatureFile
                                | NONTERM_Category_ImplementationFile -> Parser.NONTERM_implementationFile
                                | NONTERM_Category_Definition -> Parser.NONTERM_moduleDefn
                                | NONTERM_Category_Interaction -> Parser.NONTERM_interaction
                                | nt -> nt)
                            |> Set.ofList
                            |> Set.toList

                        match prodIds with
                        | [ Parser.NONTERM_interaction ] ->
                            os.AppendString(NONTERM_interactionE().Format)
                            true
                        | [ Parser.NONTERM_hashDirective ] ->
                            os.AppendString(NONTERM_hashDirectiveE().Format)
                            true
                        | [ Parser.NONTERM_fieldDecl ] ->
                            os.AppendString(NONTERM_fieldDeclE().Format)
                            true
                        | [ Parser.NONTERM_unionCaseRepr ] ->
                            os.AppendString(NONTERM_unionCaseReprE().Format)
                            true
                        | [ Parser.NONTERM_localBinding ] ->
                            os.AppendString(NONTERM_localBindingE().Format)
                            true
                        | [ Parser.NONTERM_hardwhiteLetBindings ] ->
                            os.AppendString(NONTERM_hardwhiteLetBindingsE().Format)
                            true
                        | [ Parser.NONTERM_classDefnMember ] ->
                            os.AppendString(NONTERM_classDefnMemberE().Format)
                            true
                        | [ Parser.NONTERM_defnBindings ] ->
                            os.AppendString(NONTERM_defnBindingsE().Format)
                            true
                        | [ Parser.NONTERM_classMemberSpfn ] ->
                            os.AppendString(NONTERM_classMemberSpfnE().Format)
                            true
                        | [ Parser.NONTERM_valSpfn ] ->
                            os.AppendString(NONTERM_valSpfnE().Format)
                            true
                        | [ Parser.NONTERM_tyconSpfn ] ->
                            os.AppendString(NONTERM_tyconSpfnE().Format)
                            true
                        | [ Parser.NONTERM_anonLambdaExpr ] ->
                            os.AppendString(NONTERM_anonLambdaExprE().Format)
                            true
                        | [ Parser.NONTERM_attrUnionCaseDecl ] ->
                            os.AppendString(NONTERM_attrUnionCaseDeclE().Format)
                            true
                        | [ Parser.NONTERM_cPrototype ] ->
                            os.AppendString(NONTERM_cPrototypeE().Format)
                            true
                        | [ Parser.NONTERM_objExpr | Parser.NONTERM_objectImplementationMembers ] ->
                            os.AppendString(NONTERM_objectImplementationMembersE().Format)
                            true
                        | [ Parser.NONTERM_ifExprThen | Parser.NONTERM_ifExprElifs | Parser.NONTERM_ifExprCases ] ->
                            os.AppendString(NONTERM_ifExprCasesE().Format)
                            true
                        | [ Parser.NONTERM_openDecl ] ->
                            os.AppendString(NONTERM_openDeclE().Format)
                            true
                        | [ Parser.NONTERM_fileModuleSpec ] ->
                            os.AppendString(NONTERM_fileModuleSpecE().Format)
                            true
                        | [ Parser.NONTERM_patternClauses ] ->
                            os.AppendString(NONTERM_patternClausesE().Format)
                            true
                        | [ Parser.NONTERM_beginEndExpr ] ->
                            os.AppendString(NONTERM_beginEndExprE().Format)
                            true
                        | [ Parser.NONTERM_recdExpr ] ->
                            os.AppendString(NONTERM_recdExprE().Format)
                            true
                        | [ Parser.NONTERM_tyconDefn ] ->
                            os.AppendString(NONTERM_tyconDefnE().Format)
                            true
                        | [ Parser.NONTERM_exconCore ] ->
                            os.AppendString(NONTERM_exconCoreE().Format)
                            true
                        | [ Parser.NONTERM_typeNameInfo ] ->
                            os.AppendString(NONTERM_typeNameInfoE().Format)
                            true
                        | [ Parser.NONTERM_attributeList ] ->
                            os.AppendString(NONTERM_attributeListE().Format)
                            true
                        | [ Parser.NONTERM_quoteExpr ] ->
                            os.AppendString(NONTERM_quoteExprE().Format)
                            true
                        | [ Parser.NONTERM_typeConstraint ] ->
                            os.AppendString(NONTERM_typeConstraintE().Format)
                            true
                        | [ NONTERM_Category_ImplementationFile ] ->
                            os.AppendString(NONTERM_Category_ImplementationFileE().Format)
                            true
                        | [ NONTERM_Category_Definition ] ->
                            os.AppendString(NONTERM_Category_DefinitionE().Format)
                            true
                        | [ NONTERM_Category_SignatureFile ] ->
                            os.AppendString(NONTERM_Category_SignatureFileE().Format)
                            true
                        | [ NONTERM_Category_Pattern ] ->
                            os.AppendString(NONTERM_Category_PatternE().Format)
                            true
                        | [ NONTERM_Category_Expr ] ->
                            os.AppendString(NONTERM_Category_ExprE().Format)
                            true
                        | [ NONTERM_Category_Type ] ->
                            os.AppendString(NONTERM_Category_TypeE().Format)
                            true
                        | [ Parser.NONTERM_typeArgsActual ] ->
                            os.AppendString(NONTERM_typeArgsActualE().Format)
                            true
                        | _ -> false)
1442

1443
#if DEBUG
D
Don Syme 已提交
1444 1445 1446 1447 1448
                if not foundInContext then
                    Printf.bprintf
                        os
                        ". (no 'in' context found: %+A)"
                        (List.mapSquared Parser.prodIdxToNonTerminal ctxt.ReducibleProductions)
1449
#else
D
Don Syme 已提交
1450
                foundInContext |> ignore // suppress unused variable warning in RELEASE
1451
#endif
D
Don Syme 已提交
1452 1453 1454 1455 1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474
                let fix (s: string) =
                    s
                        .Replace(SR.GetString("FixKeyword"), "")
                        .Replace(SR.GetString("FixSymbol"), "")
                        .Replace(SR.GetString("FixReplace"), "")

                let tokenNames =
                    ctxt.ShiftTokens
                    |> List.map Parser.tokenTagToTokenId
                    |> List.filter (function
                        | Parser.TOKEN_error
                        | Parser.TOKEN_EOF -> false
                        | _ -> true)
                    |> List.map tokenIdToText
                    |> Set.ofList
                    |> Set.toList

                match tokenNames with
                | [ tokenName1 ] -> os.AppendString(TokenName1E().Format(fix tokenName1))
                | [ tokenName1; tokenName2 ] -> os.AppendString(TokenName1TokenName2E().Format (fix tokenName1) (fix tokenName2))
                | [ tokenName1; tokenName2; tokenName3 ] ->
                    os.AppendString(TokenName1TokenName2TokenName3E().Format (fix tokenName1) (fix tokenName2) (fix tokenName3))
                | _ -> ()
1475
        (*
1476
              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"
1477 1478 1479 1480 1481 1482 1483 1484
                  ctxt.StateStack
                  ctxt.CurrentToken
                  (List.map Parser.tokenTagToTokenId ctxt.ShiftTokens)
                  (List.map Parser.tokenTagToTokenId ctxt.ReduceTokens)
                  ctxt.ReducibleProductions
                  (List.mapSquared Parser.prodIdxToNonTerminal ctxt.ReducibleProductions)
        *)

D
Don Syme 已提交
1485 1486 1487 1488 1489 1490
        | RuntimeCoercionSourceSealed (denv, ty, _) ->
            // REVIEW: consider if we need to show _cxs (the type parameter constraints)
            let ty, _cxs = PrettyTypes.PrettifyType denv.g ty

            if isTyparTy denv.g ty then
                os.AppendString(RuntimeCoercionSourceSealed1E().Format(NicePrint.stringOfTy denv ty))
1491
            else
D
Don Syme 已提交
1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 1516 1517 1518
                os.AppendString(RuntimeCoercionSourceSealed2E().Format(NicePrint.stringOfTy 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))

        | UpcastUnnecessary _ -> os.AppendString(UpcastUnnecessaryE().Format)

        | TypeTestUnnecessary _ -> os.AppendString(TypeTestUnnecessaryE().Format)

        | QuotationTranslator.IgnoringPartOfQuotedTermWarning (msg, _) -> Printf.bprintf os "%s" msg

        | OverrideDoesntOverride (denv, impl, minfoVirtOpt, g, amap, m) ->
            let sig1 = DispatchSlotChecking.FormatOverride denv impl

            match minfoVirtOpt with
            | None -> os.AppendString(OverrideDoesntOverride1E().Format sig1)
            | Some minfoVirt ->
                // https://github.com/dotnet/fsharp/issues/35
                // Improve error message when attempting to override generic return type with unit:
                // we need to check if unit was used as a type argument
                let hasUnitTType_app (types: TType list) =
                    types
                    |> List.exists (function
                        | TType_app (maybeUnit, [], _) ->
                            match maybeUnit.TypeAbbrev with
D
Don Syme 已提交
1519
                            | Some ty when isUnitTy g ty -> true
D
Don Syme 已提交
1520 1521 1522 1523 1524 1525 1526 1527 1528 1529 1530 1531 1532 1533 1534 1535 1536 1537 1538 1539 1540 1541 1542 1543 1544 1545 1546 1547 1548 1549 1550 1551 1552 1553 1554 1555 1556 1557 1558 1559 1560
                            | _ -> false
                        | _ -> false)

                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.AppendString(OverrideDoesntOverride2E().Format sig1)
                    let sig2 = DispatchSlotChecking.FormatMethInfoSig g amap m denv minfoVirt

                    if sig1 <> sig2 then
                        os.AppendString(OverrideDoesntOverride3E().Format sig2)

        | UnionCaseWrongArguments (_, n1, n2, _) -> os.AppendString(UnionCaseWrongArgumentsE().Format n2 n1)

        | UnionPatternsBindDifferentNames _ -> os.AppendString(UnionPatternsBindDifferentNamesE().Format)

        | ValueNotContained (denv, infoReader, mref, implVal, sigVal, f) ->
            let text1, text2 =
                NicePrint.minimalStringsOfTwoValues denv infoReader (mkLocalValRef implVal) (mkLocalValRef sigVal)

            os.AppendString(f ((fullDisplayTextOfModRef mref), text1, text2))

        | UnionCaseNotContained (denv, infoReader, enclosingTycon, v1, v2, f) ->
            let enclosingTcref = mkLocalEntityRef enclosingTycon

            os.AppendString(
                f (
                    (NicePrint.stringOfUnionCase denv infoReader enclosingTcref v1),
                    (NicePrint.stringOfUnionCase denv infoReader enclosingTcref v2)
                )
            )

        | FSharpExceptionNotContained (denv, infoReader, v1, v2, f) ->
            os.AppendString(
                f (
                    (NicePrint.stringOfExnDef denv infoReader (mkLocalEntityRef v1)),
                    (NicePrint.stringOfExnDef denv infoReader (mkLocalEntityRef v2))
                )
            )
1561

D
Don Syme 已提交
1562 1563
        | FieldNotContained (denv, infoReader, enclosingTycon, v1, v2, f) ->
            let enclosingTcref = mkLocalEntityRef enclosingTycon
1564

D
Don Syme 已提交
1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581 1582 1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618 1619 1620 1621 1622 1623 1624 1625
            os.AppendString(
                f (
                    (NicePrint.stringOfRecdField denv infoReader enclosingTcref v1),
                    (NicePrint.stringOfRecdField denv infoReader enclosingTcref v2)
                )
            )

        | RequiredButNotSpecified (_, mref, k, name, _) ->
            let nsb = StringBuilder()
            name nsb
            os.AppendString(RequiredButNotSpecifiedE().Format (fullDisplayTextOfModRef mref) k (nsb.ToString()))

        | UseOfAddressOfOperator _ -> os.AppendString(UseOfAddressOfOperatorE().Format)

        | DefensiveCopyWarning (s, _) -> os.AppendString(DefensiveCopyWarningE().Format s)

        | DeprecatedThreadStaticBindingWarning _ -> os.AppendString(DeprecatedThreadStaticBindingWarningE().Format)

        | FunctionValueUnexpected (denv, ty, _) ->
            let ty, _cxs = PrettyTypes.PrettifyType denv.g ty
            let errorText = FunctionValueUnexpectedE().Format(NicePrint.stringOfTy denv ty)
            os.AppendString errorText

        | UnitTypeExpected (denv, ty, _) ->
            let ty, _cxs = PrettyTypes.PrettifyType denv.g ty
            let warningText = UnitTypeExpectedE().Format(NicePrint.stringOfTy denv ty)
            os.AppendString warningText

        | UnitTypeExpectedWithEquality (denv, ty, _) ->
            let ty, _cxs = PrettyTypes.PrettifyType denv.g ty

            let warningText =
                UnitTypeExpectedWithEqualityE().Format(NicePrint.stringOfTy denv ty)

            os.AppendString warningText

        | UnitTypeExpectedWithPossiblePropertySetter (denv, ty, bindingName, propertyName, _) ->
            let ty, _cxs = PrettyTypes.PrettifyType denv.g ty

            let warningText =
                UnitTypeExpectedWithPossiblePropertySetterE().Format (NicePrint.stringOfTy denv ty) bindingName propertyName

            os.AppendString warningText

        | UnitTypeExpectedWithPossibleAssignment (denv, ty, isAlreadyMutable, bindingName, _) ->
            let ty, _cxs = PrettyTypes.PrettifyType denv.g ty

            let warningText =
                if isAlreadyMutable then
                    UnitTypeExpectedWithPossibleAssignmentToMutableE().Format (NicePrint.stringOfTy denv ty) bindingName
                else
                    UnitTypeExpectedWithPossibleAssignmentE().Format (NicePrint.stringOfTy denv ty) bindingName

            os.AppendString warningText

        | RecursiveUseCheckedAtRuntime _ -> os.AppendString(RecursiveUseCheckedAtRuntimeE().Format)

        | LetRecUnsound (_, [ v ], _) -> os.AppendString(LetRecUnsound1E().Format v.DisplayName)

        | LetRecUnsound (_, path, _) ->
            let bos = StringBuilder()
1626

D
Don Syme 已提交
1627 1628
            (path.Tail @ [ path.Head ])
            |> List.iter (fun (v: ValRef) -> bos.AppendString(LetRecUnsoundInnerE().Format v.DisplayName))
1629

D
Don Syme 已提交
1630
            os.AppendString(LetRecUnsound2E().Format (List.head path).DisplayName (bos.ToString()))
1631

D
Don Syme 已提交
1632
        | LetRecEvaluatedOutOfOrder (_, _, _, _) -> os.AppendString(LetRecEvaluatedOutOfOrderE().Format)
1633

D
Don Syme 已提交
1634
        | LetRecCheckedAtRuntime _ -> os.AppendString(LetRecCheckedAtRuntimeE().Format)
1635

D
Don Syme 已提交
1636
        | SelfRefObjCtor (false, _) -> os.AppendString(SelfRefObjCtor1E().Format)
1637

D
Don Syme 已提交
1638
        | SelfRefObjCtor (true, _) -> os.AppendString(SelfRefObjCtor2E().Format)
1639

D
Don Syme 已提交
1640
        | VirtualAugmentationOnNullValuedType _ -> os.AppendString(VirtualAugmentationOnNullValuedTypeE().Format)
1641

D
Don Syme 已提交
1642
        | NonVirtualAugmentationOnNullValuedType _ -> os.AppendString(NonVirtualAugmentationOnNullValuedTypeE().Format)
1643

D
Don Syme 已提交
1644 1645 1646 1647 1648 1649 1650
        | NonUniqueInferredAbstractSlot (_, denv, bindnm, bvirt1, bvirt2, _) ->
            os.AppendString(NonUniqueInferredAbstractSlot1E().Format 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)
1651

D
Don Syme 已提交
1652 1653
            if ty1 <> ty2 then
                os.AppendString(NonUniqueInferredAbstractSlot3E().Format ty1 ty2)
1654

D
Don Syme 已提交
1655
            os.AppendString(NonUniqueInferredAbstractSlot4E().Format)
1656

D
Don Syme 已提交
1657
        | DiagnosticWithText (_, s, _) -> os.AppendString s
1658

D
Don Syme 已提交
1659
        | DiagnosticWithSuggestions (_, s, _, idText, suggestionF) ->
1660
            os.AppendString(ConvertValLogicalNameToDisplayNameCore s)
1661
            OutputNameSuggestions os suggestNames suggestionF idText
D
Don Syme 已提交
1662 1663 1664 1665 1666 1667 1668 1669 1670 1671 1672 1673

        | InternalError (s, _)
        | InvalidArgument s
        | Failure s as exn ->
            ignore exn // use the argument, even in non DEBUG
            let f1 = SR.GetString("Failure1")
            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)
1674
#if DEBUG
D
Don Syme 已提交
1675 1676
            Printf.bprintf os "\nStack Trace\n%s\n" (exn.ToString())
            Debug.Assert(false, sprintf "Unexpected exception seen in compiler: %s\n%s" s (exn.ToString()))
1677 1678
#endif

1679
        | WrappedError (e, _) -> e.Output(os, suggestNames)
D
Don Syme 已提交
1680 1681 1682

        | PatternMatchCompilation.MatchIncomplete (isComp, cexOpt, _) ->
            os.AppendString(MatchIncomplete1E().Format)
1683

D
Don Syme 已提交
1684 1685 1686 1687
            match cexOpt with
            | None -> ()
            | Some (cex, false) -> os.AppendString(MatchIncomplete2E().Format cex)
            | Some (cex, true) -> os.AppendString(MatchIncomplete3E().Format cex)
1688

1689 1690
            if isComp then
                os.AppendString(MatchIncomplete4E().Format)
1691

D
Don Syme 已提交
1692 1693
        | PatternMatchCompilation.EnumMatchIncomplete (isComp, cexOpt, _) ->
            os.AppendString(EnumMatchIncomplete1E().Format)
1694

D
Don Syme 已提交
1695 1696 1697 1698
            match cexOpt with
            | None -> ()
            | Some (cex, false) -> os.AppendString(MatchIncomplete2E().Format cex)
            | Some (cex, true) -> os.AppendString(MatchIncomplete3E().Format cex)
1699

1700 1701
            if isComp then
                os.AppendString(MatchIncomplete4E().Format)
1702

D
Don Syme 已提交
1703
        | PatternMatchCompilation.RuleNeverMatched _ -> os.AppendString(RuleNeverMatchedE().Format)
1704

D
Don Syme 已提交
1705
        | ValNotMutable (_, vref, _) -> os.AppendString(ValNotMutableE().Format(vref.DisplayName))
D
Don Syme 已提交
1706 1707 1708 1709 1710 1711

        | ValNotLocal _ -> os.AppendString(ValNotLocalE().Format)

        | ObsoleteError (s, _)

        | ObsoleteWarning (s, _) ->
D
Don Syme 已提交
1712
            os.AppendString(Obsolete1E().Format)
1713 1714 1715

            if s <> "" then
                os.AppendString(Obsolete2E().Format s)
1716

D
Don Syme 已提交
1717 1718 1719 1720 1721 1722 1723 1724 1725 1726 1727 1728 1729 1730 1731 1732 1733 1734 1735 1736 1737
        | Experimental (s, _) -> os.AppendString(ExperimentalE().Format s)

        | PossibleUnverifiableCode _ -> os.AppendString(PossibleUnverifiableCodeE().Format)

        | UserCompilerMessage (msg, _, _) -> os.AppendString msg

        | Deprecated (s, _) -> os.AppendString(DeprecatedE().Format s)

        | LibraryUseOnly _ -> os.AppendString(LibraryUseOnlyE().Format)

        | MissingFields (sl, _) -> os.AppendString(MissingFieldsE().Format(String.concat "," sl + "."))

        | ValueRestriction (denv, infoReader, hasSig, v, _, _) ->
            let denv =
                { denv with
                    showInferenceTyparAnnotations = true
                }

            let tau = v.TauType

            if hasSig then
1738
                if isFunTy denv.g tau && (arityOfVal v).HasNoArgs then
D
Don Syme 已提交
1739
                    let msg =
D
Don Syme 已提交
1740
                        ValueRestriction1E().Format
D
Don Syme 已提交
1741 1742 1743
                            v.DisplayName
                            (NicePrint.stringOfQualifiedValOrMember denv infoReader (mkLocalValRef v))
                            v.DisplayName
D
Don Syme 已提交
1744

D
Don Syme 已提交
1745
                    os.AppendString msg
1746
                else
D
Don Syme 已提交
1747
                    let msg =
D
Don Syme 已提交
1748
                        ValueRestriction2E().Format
D
Don Syme 已提交
1749 1750 1751
                            v.DisplayName
                            (NicePrint.stringOfQualifiedValOrMember denv infoReader (mkLocalValRef v))
                            v.DisplayName
D
Don Syme 已提交
1752 1753 1754 1755 1756 1757 1758 1759 1760 1761 1762 1763 1764 1765 1766 1767

                    os.AppendString msg
            else
                match v.MemberInfo with
                | Some membInfo when
                    (match membInfo.MemberFlags.MemberKind with
                     | SynMemberKind.PropertyGet
                     | SynMemberKind.PropertySet
                     | SynMemberKind.Constructor -> true // can't infer extra polymorphism
                     // can infer extra polymorphism
                     | _ -> false)
                    ->
                    let msg =
                        ValueRestriction3E()
                            .Format(NicePrint.stringOfQualifiedValOrMember denv infoReader (mkLocalValRef v))

D
Don Syme 已提交
1768
                    os.AppendString msg
D
Don Syme 已提交
1769 1770 1771 1772 1773 1774 1775 1776 1777 1778 1779 1780 1781 1782 1783
                | _ ->
                    if isFunTy denv.g tau && (arityOfVal v).HasNoArgs then
                        let msg =
                            ValueRestriction4E().Format
                                v.DisplayName
                                (NicePrint.stringOfQualifiedValOrMember denv infoReader (mkLocalValRef v))
                                v.DisplayName

                        os.AppendString msg
                    else
                        let msg =
                            ValueRestriction5E().Format
                                v.DisplayName
                                (NicePrint.stringOfQualifiedValOrMember denv infoReader (mkLocalValRef v))
                                v.DisplayName
1784

D
Don Syme 已提交
1785
                        os.AppendString msg
1786

D
Don Syme 已提交
1787
        | Parsing.RecoverableParseError -> os.AppendString(RecoverableParseErrorE().Format)
1788

D
Don Syme 已提交
1789
        | ReservedKeyword (s, _) -> os.AppendString(ReservedKeywordE().Format s)
1790

D
Don Syme 已提交
1791
        | IndentationProblem (s, _) -> os.AppendString(IndentationProblemE().Format s)
1792

D
Don Syme 已提交
1793
        | OverrideInIntrinsicAugmentation _ -> os.AppendString(OverrideInIntrinsicAugmentationE().Format)
1794

D
Don Syme 已提交
1795
        | OverrideInExtrinsicAugmentation _ -> os.AppendString(OverrideInExtrinsicAugmentationE().Format)
1796

D
Don Syme 已提交
1797
        | IntfImplInIntrinsicAugmentation _ -> os.AppendString(IntfImplInIntrinsicAugmentationE().Format)
1798

D
Don Syme 已提交
1799
        | IntfImplInExtrinsicAugmentation _ -> os.AppendString(IntfImplInExtrinsicAugmentationE().Format)
1800

D
Don Syme 已提交
1801 1802
        | UnresolvedReferenceError (assemblyName, _)
        | UnresolvedReferenceNoRange assemblyName -> os.AppendString(UnresolvedReferenceNoRangeE().Format assemblyName)
1803

D
Don Syme 已提交
1804
        | UnresolvedPathReference (assemblyName, pathname, _)
1805

D
Don Syme 已提交
1806 1807
        | UnresolvedPathReferenceNoRange (assemblyName, pathname) ->
            os.AppendString(UnresolvedPathReferenceNoRangeE().Format pathname assemblyName)
1808

D
Don Syme 已提交
1809
        | DeprecatedCommandLineOptionFull (fullText, _) -> os.AppendString fullText
1810

D
Don Syme 已提交
1811
        | DeprecatedCommandLineOptionForHtmlDoc (optionName, _) -> os.AppendString(FSComp.SR.optsDCLOHtmlDoc optionName)
1812

D
Don Syme 已提交
1813 1814
        | DeprecatedCommandLineOptionSuggestAlternative (optionName, altOption, _) ->
            os.AppendString(FSComp.SR.optsDCLODeprecatedSuggestAlternative (optionName, altOption))
1815

D
Don Syme 已提交
1816
        | InternalCommandLineOption (optionName, _) -> os.AppendString(FSComp.SR.optsInternalNoDescription optionName)
1817

D
Don Syme 已提交
1818
        | DeprecatedCommandLineOptionNoDescription (optionName, _) -> os.AppendString(FSComp.SR.optsDCLONoDescription optionName)
1819

D
Don Syme 已提交
1820
        | HashIncludeNotAllowedInNonScript _ -> os.AppendString(HashIncludeNotAllowedInNonScriptE().Format)
1821

D
Don Syme 已提交
1822
        | HashReferenceNotAllowedInNonScript _ -> os.AppendString(HashReferenceNotAllowedInNonScriptE().Format)
1823

D
Don Syme 已提交
1824
        | HashDirectiveNotAllowedInNonScript _ -> os.AppendString(HashDirectiveNotAllowedInNonScriptE().Format)
1825

D
Don Syme 已提交
1826
        | FileNameNotResolved (fileName, locations, _) -> os.AppendString(FileNameNotResolvedE().Format fileName locations)
1827

D
Don Syme 已提交
1828
        | AssemblyNotResolved (originalName, _) -> os.AppendString(AssemblyNotResolvedE().Format originalName)
1829

D
Don Syme 已提交
1830 1831
        | IllegalFileNameChar (fileName, invalidChar) ->
            os.AppendString(FSComp.SR.buildUnexpectedFileNameCharacter (fileName, string invalidChar) |> snd)
1832

D
Don Syme 已提交
1833
        | HashLoadedSourceHasIssues (infos, warnings, errors, _) ->
1834

1835 1836
            match warnings, errors with
            | _, e :: _ ->
D
Don Syme 已提交
1837
                os.AppendString(HashLoadedSourceHasIssues2E().Format)
1838 1839 1840 1841 1842 1843 1844
                e.Output(os, suggestNames)
            | e :: _, _ ->
                os.AppendString(HashLoadedSourceHasIssues1E().Format)
                e.Output(os, suggestNames)
            | [], [] ->
                os.AppendString(HashLoadedSourceHasIssues0E().Format)
                infos.Head.Output(os, suggestNames)
D
Don Syme 已提交
1845 1846 1847 1848 1849 1850 1851

        | HashLoadedScriptConsideredSource _ -> os.AppendString(HashLoadedScriptConsideredSourceE().Format)

        | InvalidInternalsVisibleToAssemblyName (badName, fileNameOption) ->
            match fileNameOption with
            | Some file -> os.AppendString(InvalidInternalsVisibleToAssemblyName1E().Format badName file)
            | None -> os.AppendString(InvalidInternalsVisibleToAssemblyName2E().Format badName)
1852

D
Don Syme 已提交
1853
        | LoadedSourceNotFoundIgnoring (fileName, _) -> os.AppendString(LoadedSourceNotFoundIgnoringE().Format fileName)
1854

D
Don Syme 已提交
1855
        | MSBuildReferenceResolutionWarning (code, message, _)
1856

D
Don Syme 已提交
1857
        | MSBuildReferenceResolutionError (code, message, _) -> os.AppendString(MSBuildReferenceResolutionErrorE().Format message code)
1858

D
Don Syme 已提交
1859
        // Strip TargetInvocationException wrappers
1860
        | :? TargetInvocationException as exn -> exn.InnerException.Output(os, suggestNames)
1861

D
Don Syme 已提交
1862
        | :? FileNotFoundException as exn -> Printf.bprintf os "%s" exn.Message
1863

D
Don Syme 已提交
1864
        | :? DirectoryNotFoundException as exn -> Printf.bprintf os "%s" exn.Message
1865

D
Don Syme 已提交
1866
        | :? ArgumentException as exn -> Printf.bprintf os "%s" exn.Message
1867

D
Don Syme 已提交
1868
        | :? NotSupportedException as exn -> Printf.bprintf os "%s" exn.Message
1869

D
Don Syme 已提交
1870
        | :? IOException as exn -> Printf.bprintf os "%s" exn.Message
1871

D
Don Syme 已提交
1872
        | :? UnauthorizedAccessException as exn -> Printf.bprintf os "%s" exn.Message
1873

D
Don Syme 已提交
1874 1875
        | exn ->
            os.AppendString(TargetInvocationExceptionWrapperE().Format exn.Message)
1876
#if DEBUG
D
Don Syme 已提交
1877 1878 1879 1880
            Printf.bprintf os "\nStack Trace\n%s\n" (exn.ToString())

            if showAssertForUnexpectedException.Value then
                Debug.Assert(false, sprintf "Unknown exception seen in compiler: %s" (exn.ToString()))
1881 1882
#endif

1883 1884
/// Eagerly format a PhasedDiagnostic to a DiagnosticWithText
type PhasedDiagnostic with
1885

1886 1887 1888
    // remove any newlines and tabs
    member x.OutputCore(os: StringBuilder, flattenErrors: bool, suggestNames: bool) =
        let buf = StringBuilder()
1889

1890
        x.Exception.Output(buf, suggestNames)
D
Don Syme 已提交
1891

1892 1893 1894 1895 1896 1897 1898 1899 1900 1901 1902 1903
        let text =
            if flattenErrors then
                NormalizeErrorString(buf.ToString())
            else
                buf.ToString()

        os.AppendString text

    member x.FormatCore(flattenErrors: bool, suggestNames: bool) =
        let os = StringBuilder()
        x.OutputCore(os, flattenErrors, suggestNames)
        os.ToString()
1904

1905 1906 1907 1908 1909 1910 1911 1912 1913
    member x.EagerlyFormatCore(suggestNames: bool) =
        match x.Range with
        | Some m ->
            let buf = StringBuilder()
            x.Exception.Output(buf, suggestNames)
            let message = buf.ToString()
            let exn = DiagnosticWithText(x.Number, message, m)
            { Exception = exn; Phase = x.Phase }
        | None -> x
1914 1915 1916

let SanitizeFileName fileName implicitIncludeDir =
    // The assert below is almost ok, but it fires in two cases:
D
Don Syme 已提交
1917
    //  - fsi.exe sometimes passes "stdin" as a dummy file name
1918
    //  - if you have a #line directive, e.g.
1919 1920 1921 1922 1923
    //        # 1000 "Line01.fs"
    //    then it also asserts. But these are edge cases that can be fixed later, e.g. in bug 4651.
    try
        let fullPath = FileSystem.GetFullPathShim fileName
        let currentDir = implicitIncludeDir
1924

1925
        // if the file name is not rooted in the current directory, return the full path
D
Don Syme 已提交
1926
        if not (fullPath.StartsWithOrdinal currentDir) then
1927 1928 1929
            fullPath
        // if the file name is rooted in the current directory, return the relative path
        else
D
Don Syme 已提交
1930
            fullPath.Replace(currentDir + "\\", "")
1931 1932 1933 1934
    with _ ->
        fileName

[<RequireQualifiedAccess>]
D
Don Syme 已提交
1935
type FormattedDiagnosticLocation =
D
Don Syme 已提交
1936 1937 1938 1939 1940 1941
    {
        Range: range
        File: string
        TextRepresentation: string
        IsEmpty: bool
    }
1942 1943

[<RequireQualifiedAccess>]
D
Don Syme 已提交
1944
type FormattedDiagnosticCanonicalInformation =
D
Don Syme 已提交
1945 1946 1947 1948 1949
    {
        ErrorNumber: int
        Subcategory: string
        TextRepresentation: string
    }
1950 1951

[<RequireQualifiedAccess>]
D
Don Syme 已提交
1952
type FormattedDiagnosticDetailedInfo =
D
Don Syme 已提交
1953 1954 1955 1956 1957
    {
        Location: FormattedDiagnosticLocation option
        Canonical: FormattedDiagnosticCanonicalInformation
        Message: string
    }
1958 1959

[<RequireQualifiedAccess>]
D
Don Syme 已提交
1960
type FormattedDiagnostic =
1961
    | Short of FSharpDiagnosticSeverity * string
D
Don Syme 已提交
1962
    | Long of FSharpDiagnosticSeverity * FormattedDiagnosticDetailedInfo
1963

1964 1965 1966 1967 1968 1969 1970 1971 1972 1973
let FormatDiagnosticLocation (tcConfig: TcConfig) m : FormattedDiagnosticLocation =
    if equals m rangeStartup || equals m rangeCmdArgs then
        {
            Range = m
            TextRepresentation = ""
            IsEmpty = true
            File = ""
        }
    else
        let file = m.FileName
D
Don Syme 已提交
1974

1975 1976 1977 1978 1979 1980 1981 1982 1983 1984 1985 1986 1987 1988 1989 1990 1991 1992 1993 1994 1995 1996 1997 1998 1999 2000 2001 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2014 2015 2016 2017 2018
        let file =
            if tcConfig.showFullPaths then
                FileSystem.GetFullFilePathInDirectoryShim tcConfig.implicitIncludeDir file
            else
                SanitizeFileName file tcConfig.implicitIncludeDir

        let text, m, file =
            match tcConfig.diagnosticStyle with
            | DiagnosticStyle.Emacs ->
                let file = file.Replace("\\", "/")
                (sprintf "File \"%s\", line %d, characters %d-%d: " file m.StartLine m.StartColumn m.EndColumn), m, file

            // We're adjusting the columns here to be 1-based - both for parity with C# and for MSBuild, which assumes 1-based columns for error output
            | DiagnosticStyle.Default ->
                let file = file.Replace('/', Path.DirectorySeparatorChar)
                let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) m.End
                (sprintf "%s(%d,%d): " file m.StartLine m.StartColumn), m, file

            // We may also want to change Test to be 1-based
            | DiagnosticStyle.Test ->
                let file = file.Replace("/", "\\")

                let m =
                    mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1))

                sprintf "%s(%d,%d-%d,%d): " file m.StartLine m.StartColumn m.EndLine m.EndColumn, m, file

            | DiagnosticStyle.Gcc ->
                let file = file.Replace('/', Path.DirectorySeparatorChar)

                let m =
                    mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1))

                sprintf "%s:%d:%d: " file m.StartLine m.StartColumn, m, file

            // Here, we want the complete range information so Project Systems can generate proper squiggles
            | DiagnosticStyle.VisualStudio ->
                // Show prefix only for real files. Otherwise, we just want a truncated error like:
                //      parse error FS0031: blah blah
                if
                    not (equals m range0)
                    && not (equals m rangeStartup)
                    && not (equals m rangeCmdArgs)
                then
2019
                    let file = file.Replace("/", "\\")
D
Don Syme 已提交
2020 2021 2022 2023

                    let m =
                        mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1))

2024 2025 2026
                    sprintf "%s(%d,%d,%d,%d): " file m.StartLine m.StartColumn m.EndLine m.EndColumn, m, file
                else
                    "", m, file
D
Don Syme 已提交
2027

2028 2029 2030 2031 2032 2033
        {
            Range = m
            TextRepresentation = text
            IsEmpty = false
            File = file
        }
D
Don Syme 已提交
2034

2035 2036
/// returns sequence that contains Diagnostic for the given error + Diagnostic for all related errors
let CollectFormattedDiagnostics (tcConfig: TcConfig, severity: FSharpDiagnosticSeverity, diagnostic: PhasedDiagnostic, suggestNames: bool) =
2037

D
Don Syme 已提交
2038
    match diagnostic.Exception with
2039 2040
    | ReportedError _ ->
        assert ("" = "Unexpected ReportedError") //  this should never happen
D
Don Syme 已提交
2041
        [||]
2042 2043
    | StopProcessing ->
        assert ("" = "Unexpected StopProcessing") // this should never happen
D
Don Syme 已提交
2044
        [||]
2045
    | _ ->
2046
        let errors = ResizeArray()
D
Don Syme 已提交
2047

2048 2049 2050 2051
        let report (diagnostic: PhasedDiagnostic) =
            let where =
                match diagnostic.Range with
                | Some m -> FormatDiagnosticLocation tcConfig m |> Some
2052 2053
                | None -> None

2054 2055
            let subcategory = diagnostic.Subcategory()
            let errorNumber = diagnostic.Number
D
Don Syme 已提交
2056

2057 2058 2059 2060 2061 2062 2063 2064 2065 2066 2067 2068 2069 2070
            let message =
                match severity with
                | FSharpDiagnosticSeverity.Error -> "error"
                | FSharpDiagnosticSeverity.Warning -> "warning"
                | FSharpDiagnosticSeverity.Info
                | FSharpDiagnosticSeverity.Hidden -> "info"

            let text =
                match tcConfig.diagnosticStyle with
                // Show the subcategory for --vserrors so that we can fish it out in Visual Studio and use it to determine error stickiness.
                | DiagnosticStyle.VisualStudio -> sprintf "%s %s FS%04d: " subcategory message errorNumber
                | _ -> sprintf "%s FS%04d: " message errorNumber

            let canonical: FormattedDiagnosticCanonicalInformation =
D
Don Syme 已提交
2071 2072 2073 2074 2075
                {
                    ErrorNumber = errorNumber
                    Subcategory = subcategory
                    TextRepresentation = text
                }
2076

2077
            let message = diagnostic.FormatCore(tcConfig.flatErrors, suggestNames)
2078

D
Don Syme 已提交
2079 2080 2081 2082 2083 2084
            let entry: FormattedDiagnosticDetailedInfo =
                {
                    Location = where
                    Canonical = canonical
                    Message = message
                }
2085

D
Don Syme 已提交
2086
            errors.Add(FormattedDiagnostic.Long(severity, entry))
2087

2088
        match diagnostic.Exception with
2089
#if !NO_TYPEPROVIDERS
2090
        | :? TypeProviderError as tpe -> tpe.Iter(fun exn -> report { diagnostic with Exception = exn })
2091
#endif
2092
        | _ -> report diagnostic
2093

D
Don Syme 已提交
2094
        errors.ToArray()
2095

2096
type PhasedDiagnostic with
2097

2098 2099 2100
    /// used by fsc.exe and fsi.exe, but not by VS
    /// prints error and related errors to the specified StringBuilder
    member diagnostic.Output(buf, tcConfig: TcConfig, severity) =
D
Don Syme 已提交
2101

2102 2103
        // 'true' for "canSuggestNames" is passed last here because we want to report suggestions in fsc.exe and fsi.exe, just not in regular IDE usage.
        let diagnostics = CollectFormattedDiagnostics(tcConfig, severity, diagnostic, true)
D
Don Syme 已提交
2104

2105 2106 2107 2108
        for e in diagnostics do
            Printf.bprintf buf "\n"

            match e with
2109
            | FormattedDiagnostic.Short (_, txt) -> buf.AppendString txt
2110 2111 2112 2113
            | FormattedDiagnostic.Long (_, details) ->
                match details.Location with
                | Some l when not l.IsEmpty -> buf.AppendString l.TextRepresentation
                | _ -> ()
D
Don Syme 已提交
2114

2115 2116 2117 2118 2119 2120 2121 2122 2123 2124 2125 2126 2127 2128 2129 2130 2131 2132 2133 2134 2135 2136 2137
                buf.AppendString details.Canonical.TextRepresentation
                buf.AppendString details.Message

    member diagnostic.OutputContext(buf, prefix, fileLineFunction) =
        match diagnostic.Range with
        | None -> ()
        | Some m ->
            let fileName = m.FileName
            let lineA = m.StartLine
            let lineB = m.EndLine
            let line = fileLineFunction fileName lineA

            if line <> "" then
                let iA = m.StartColumn
                let iB = m.EndColumn
                let iLen = if lineA = lineB then max (iB - iA) 1 else 1
                Printf.bprintf buf "%s%s\n" prefix line
                Printf.bprintf buf "%s%s%s\n" prefix (String.make iA '-') (String.make iLen '^')

    member diagnostic.WriteWithContext(os, prefix, fileLineFunction, tcConfig, severity) =
        writeViaBuffer os (fun buf ->
            diagnostic.OutputContext(buf, prefix, fileLineFunction)
            diagnostic.Output(buf, tcConfig, severity))
2138 2139 2140 2141

//----------------------------------------------------------------------------
// Scoped #nowarn pragmas

D
Don Syme 已提交
2142
/// Build an DiagnosticsLogger that delegates to another DiagnosticsLogger but filters warnings turned off by the given pragma declarations
2143
//
2144
// NOTE: we allow a flag to turn of strict file checking. This is because file names sometimes don't match due to use of
2145 2146
// #line directives, e.g. for pars.fs/pars.fsy. In this case we just test by line number - in most cases this is sufficient
// because we install a filtering error handler on a file-by-file basis for parsing and type-checking.
2147
// However this is indicative of a more systematic problem where source-line
2148 2149
// sensitive operations (lexfilter and warning filtering) do not always
// interact well with #line directives.
D
Don Syme 已提交
2150 2151 2152 2153 2154 2155 2156
type DiagnosticsLoggerFilteringByScopedPragmas
    (
        checkFile,
        scopedPragmas,
        diagnosticOptions: FSharpDiagnosticOptions,
        diagnosticsLogger: DiagnosticsLogger
    ) =
D
Don Syme 已提交
2157
    inherit DiagnosticsLogger("DiagnosticsLoggerFilteringByScopedPragmas")
2158

2159
    override _.DiagnosticSink(diagnostic: PhasedDiagnostic, severity) =
2160
        if severity = FSharpDiagnosticSeverity.Error then
D
Don Syme 已提交
2161
            diagnosticsLogger.DiagnosticSink(diagnostic, severity)
2162
        else
2163
            let report =
2164
                let warningNum = diagnostic.Number
D
Don Syme 已提交
2165

2166
                match diagnostic.Range with
2167
                | Some m ->
D
Don Syme 已提交
2168 2169
                    scopedPragmas
                    |> List.exists (fun pragma ->
D
Don Syme 已提交
2170 2171 2172 2173 2174
                        let (ScopedPragma.WarningOff (pragmaRange, warningNumFromPragma)) = pragma

                        warningNum = warningNumFromPragma
                        && (not checkFile || m.FileIndex = pragmaRange.FileIndex)
                        && posGeq m.Start pragmaRange.Start)
D
Don Syme 已提交
2175
                    |> not
2176
                | None -> true
D
Don Syme 已提交
2177

2178
            if report then
2179
                if diagnostic.ReportAsError(diagnosticOptions, severity) then
D
Don Syme 已提交
2180
                    diagnosticsLogger.DiagnosticSink(diagnostic, FSharpDiagnosticSeverity.Error)
2181
                elif diagnostic.ReportAsWarning(diagnosticOptions, severity) then
D
Don Syme 已提交
2182
                    diagnosticsLogger.DiagnosticSink(diagnostic, FSharpDiagnosticSeverity.Warning)
2183
                elif diagnostic.ReportAsInfo(diagnosticOptions, severity) then
D
Don Syme 已提交
2184
                    diagnosticsLogger.DiagnosticSink(diagnostic, severity)
2185

D
Don Syme 已提交
2186
    override _.ErrorCount = diagnosticsLogger.ErrorCount
2187

D
Don Syme 已提交
2188
let GetDiagnosticsLoggerFilteringByScopedPragmas (checkFile, scopedPragmas, diagnosticOptions, diagnosticsLogger) =
D
Don Syme 已提交
2189
    DiagnosticsLoggerFilteringByScopedPragmas(checkFile, scopedPragmas, diagnosticOptions, diagnosticsLogger) :> DiagnosticsLogger