Feature: Improve diagnostic messages

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

@@ -22,3 +22,9 @@
 
 * Added warning FS3884 when a function or delegate value is used as an interpolated string argument. ([PR #19289](https://github.com/dotnet/fsharp/pull/19289))
 * Add `#version;;` directive to F# Interactive to display version and environment information. ([Issue #13307](https://github.com/dotnet/fsharp/issues/13307), [PR #19332](https://github.com/dotnet/fsharp/pull/19332))
+
+### Changed
+
+* Improvements in error and warning messages. ([PR #19398](https://github.com/dotnet/fsharp/pull/19398))
+
+### Breaking Changes

src/Compiler/Checking/Expressions/CheckExpressions.fs

@@ -4113,6 +4113,12 @@ type ImplicitlyBoundTyparsAllowed =
     | NewTyparsOK
     | NoNewTypars
 
+/// Formats a list of names for display in diagnostics, truncating to at most 5 entries.
+let formatAvailableNames (names: string array) =
+    let truncated = names |> Array.truncate 5
+    let result = truncated |> String.concat ", "
+    if names.Length > 5 then result + ", ..." else result
+
 //-------------------------------------------------------------------------
 // Checking types and type constraints
 //-------------------------------------------------------------------------
@@ -5017,7 +5023,12 @@ and CrackStaticConstantArgs (cenv: cenv) env tpenv (staticParameters: Tainted<Pr
              if staticParameters |> Array.exists (fun sp -> n.idText = sp.PUntaint((fun sp -> sp.Name), n.idRange)) then
                  error (Error(FSComp.SR.etStaticParameterAlreadyHasValue n.idText, n.idRange))
              else
-                 error (Error(FSComp.SR.etNoStaticParameterWithName n.idText, n.idRange))
+                 let availableNames =
+                     staticParameters
+                     |> Array.map (fun sp -> sp.PUntaint((fun sp -> sp.Name), n.idRange))
+                     |> formatAvailableNames
+
+                 error (Error(FSComp.SR.etNoStaticParameterWithName (n.idText, availableNames), n.idRange))
          | [_] -> ()
          | _ -> error (Error(FSComp.SR.etMultipleStaticParameterWithName n.idText, n.idRange))
 
@@ -6148,6 +6159,8 @@ and TcExprUndelayed (cenv: cenv) (overallTy: OverallTy) env tpenv (synExpr: SynE
     | SynExpr.MatchBang (trivia = { MatchBangKeyword = m })
     | SynExpr.WhileBang (range = m) ->
         error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m))
+
+
     | SynExpr.IndexFromEnd (rightExpr, m) ->
         errorR(Error(FSComp.SR.tcTraitInvocationShouldUseTick(), m))
         let adjustedExpr = ParseHelpers.adjustHatPrefixToTyparLookup m rightExpr
@@ -6280,6 +6293,11 @@ and TcExprTuple (cenv: cenv) overallTy env tpenv (isExplicitStruct, args, m) =
 and TcExprArrayOrList (cenv: cenv) overallTy env tpenv (isArray, args, m) =
     let g = cenv.g
 
+    match isArray, args with
+    | false, [ SynExpr.Tuple(false, _, _, _) ] ->
+        informationalWarning (Error(FSComp.SR.tcListLiteralWithSingleTupleElement (), m))
+    | _ -> ()
+
     CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy.Commit, env.AccessRights)
     let argTy = NewInferenceType g
     let actualTy = if isArray then mkArrayType g argTy else mkListTy g argTy
@@ -8281,11 +8299,40 @@ and TcForEachExpr cenv overallTy env tpenv (seqExprOnly, isFromSource, synPat, s
     // Add the pattern match compilation
     let bodyExpr =
         let valsDefinedByMatching = ListSet.remove valEq elemVar vspecs
-        CompilePatternForMatch
-            cenv env synEnumExpr.Range pat.Range false IgnoreWithWarning (elemVar, [], None)
-            [MatchClause(pat, None, TTarget(valsDefinedByMatching, bodyExpr, None), mIn)]
-            enumElemTy
-            overallTy.Commit
+
+        let isConstantPattern =
+            match synPat with
+            | SynPat.Const _
+            | SynPat.Paren(SynPat.Const _, _)
+            | SynPat.Typed(SynPat.Const _, _, _)
+            | SynPat.Paren(SynPat.Typed(SynPat.Const _, _, _), _) -> true
+            | _ -> false
+
+        let compileMatch () =
+            CompilePatternForMatch
+                cenv env synEnumExpr.Range pat.Range false IgnoreWithWarning (elemVar, [], None)
+                [MatchClause(pat, None, TTarget(valsDefinedByMatching, bodyExpr, None), mIn)]
+                enumElemTy
+                overallTy.Commit
+
+        if isConstantPattern then
+            use _ =
+                UseTransformedDiagnosticsLogger(fun oldLogger ->
+                    { new DiagnosticsLogger("forLoopConstantHint") with
+                        member _.DiagnosticSink(diagnostic) =
+                            match diagnostic.Exception with
+                            | MatchIncomplete _ ->
+                                oldLogger.DiagnosticSink(
+                                    { diagnostic with
+                                        Exception = MatchIncompleteForLoopHint(diagnostic.Exception) })
+                            | _ -> oldLogger.DiagnosticSink(diagnostic)
+
+                        member _.ErrorCount = oldLogger.ErrorCount
+                    })
+
+            compileMatch ()
+        else
+            compileMatch ()
 
     // Apply the fixup to bind the elemVar if needed
     let bodyExpr = bodyExprFixup elemVar bodyExpr
@@ -8452,15 +8499,17 @@ and Propagate (cenv: cenv) (overallTy: OverallTy) (env: TcEnv) tpenv (expr: Appl
                         else
                             if IsIndexerType g cenv.amap expr.Type then
                                 let old = not (g.langVersion.SupportsFeature LanguageFeature.IndexerNotationWithoutDot)
+                                // NotAFunctionButIndexer uses overallTy (expected type) for the indexer suggestion message.
                                 error (NotAFunctionButIndexer(denv, overallTy.Commit, vName, mExpr, mArg, old))
                             else
-                                error (NotAFunction(denv, overallTy.Commit, mExpr, mArg))
+                                // NotAFunction uses exprTy (actual type) to show "has type X, which does not accept arguments".
+                                error (NotAFunction(denv, exprTy, mExpr, mArg))
 
                 // f x  (where 'f' is not a function)
                 | _ ->
                     // 'delayed' is about to be dropped on the floor, first do rudimentary checking to get name resolutions in its body
                     RecordNameAndTypeResolutionsDelayed cenv env tpenv delayed
-                    error (NotAFunction(denv, overallTy.Commit, mExpr, mArg))
+                    error (NotAFunction(denv, exprTy, mExpr, mArg))
 
     propagate false delayed expr.Range exprTy
 
@@ -8781,7 +8830,7 @@ and TcApplicationThen (cenv: cenv) (overallTy: OverallTy) env tpenv mExprAndArg
             TcDelayed cenv overallTy env tpenv mExprAndArg (MakeApplicableExprNoFlex cenv bodyOfCompExpr) (tyOfExpr g bodyOfCompExpr) ExprAtomicFlag.NonAtomic delayed
 
         | _ ->
-            error (NotAFunction(denv, overallTy.Commit, mLeftExpr, mArg))
+            error (NotAFunction(denv, exprTy, mLeftExpr, mArg))
 
 //-------------------------------------------------------------------------
 // TcLongIdentThen: Typecheck "A.B.C<D>.E.F ... " constructs
@@ -9344,7 +9393,6 @@ and TcImplicitOpItemThen (cenv: cenv) overallTy env id sln tpenv mItem delayed =
         | SynExpr.YieldOrReturn _
         | SynExpr.YieldOrReturnFrom _
         | SynExpr.MatchBang _
-        | LetOrUse(_, true, _)
         | SynExpr.DoBang _
         | SynExpr.WhileBang _
         | SynExpr.TraitCall _
@@ -10759,6 +10807,13 @@ and CheckRecursiveBindingIds binds =
         if nm <> "" && not (hashOfBinds.Add nm) then
             error(Duplicate("value", nm, m))
 
+/// Returns true if the expression is an elif chain that ends without a final 'else' branch.
+and elifChainMissingElse expr =
+    match expr with
+    | SynExpr.IfThenElse(elseExpr = None) -> true
+    | SynExpr.IfThenElse(elseExpr = Some elseExpr) -> elifChainMissingElse elseExpr
+    | _ -> false
+
 /// Process a sequence of sequentials mixed with iterated lets "let ... in let ... in ..." in a tail recursive way
 /// This avoids stack overflow on really large "let" and "letrec" lists
 and TcLinearExprs bodyChecker cenv env overallTy tpenv isCompExpr synExpr cont =
@@ -10805,12 +10860,15 @@ and TcLinearExprs bodyChecker cenv env overallTy tpenv isCompExpr synExpr cont =
         let env = { env with eIsControlFlow = true }
         let thenExpr, tpenv =
             let env =
-                match env.eContextInfo with
-                | ContextInfo.ElseBranchResult _ -> { env with eContextInfo = ContextInfo.ElseBranchResult synThenExpr.Range }
-                | _ ->
-                    match synElseExprOpt with
-                    | None -> { env with eContextInfo = ContextInfo.OmittedElseBranch synThenExpr.Range }
-                    | _ -> { env with eContextInfo = ContextInfo.IfExpression synThenExpr.Range }
+                match env.eContextInfo, synElseExprOpt with
+                // Inside an elif chain with no final else: use full elif range (m) so the error points at the whole elif.
+                | ContextInfo.ElseBranchResult _, None -> { env with eContextInfo = ContextInfo.OmittedElseBranch m }
+                | ContextInfo.ElseBranchResult _, _ -> { env with eContextInfo = ContextInfo.ElseBranchResult synThenExpr.Range }
+                // Top-level if with no else: use then-branch range.
+                | _, None -> { env with eContextInfo = ContextInfo.OmittedElseBranch synThenExpr.Range }
+                | _, Some elseExpr when elifChainMissingElse elseExpr ->
+                    { env with eContextInfo = ContextInfo.OmittedElseBranch synThenExpr.Range }
+                | _ -> { env with eContextInfo = ContextInfo.IfExpression synThenExpr.Range }
 
             if not isRecovery && Option.isNone synElseExprOpt then
                 UnifyTypes cenv env m g.unit_ty overallTy.Commit

src/Compiler/Checking/Expressions/CheckExpressions.fsi

@@ -135,6 +135,9 @@ type ImplicitlyBoundTyparsAllowed =
     | NewTyparsOK
     | NoNewTypars
 
+/// Formats a list of names for display in diagnostics, truncating to at most 5 entries.
+val internal formatAvailableNames: names: string array -> string
+
 //-------------------------------------------------------------------------
 // The rest are all helpers needed for declaration checking (CheckDeclarations.fs)
 //-------------------------------------------------------------------------

src/Compiler/Checking/PatternMatchCompilation.fs

@@ -24,7 +24,13 @@ open FSharp.Compiler.TypedTreeOps
 open FSharp.Compiler.TypeRelations
 open type System.MemoryExtensions
 
+/// Exception raised when a pattern match is incomplete.
+/// Fields: isComputationExpression * (counterExample * isShownAsFieldPattern) option * range
 exception MatchIncomplete of bool * (string * bool) option * range
+
+/// Wrapper that adds a for-loop hint to an existing MatchIncomplete diagnostic.
+exception MatchIncompleteForLoopHint of exn
+
 exception RuleNeverMatched of range
 exception EnumMatchIncomplete of bool * (string * bool) option * range
 

src/Compiler/Checking/PatternMatchCompilation.fsi

@@ -71,8 +71,13 @@ val internal CompilePattern:
         TType ->
             DecisionTree * DecisionTreeTarget list
 
+/// Exception raised when a pattern match is incomplete.
+/// Fields: isComputationExpression * (counterExample * isShownAsFieldPattern) option * range
 exception internal MatchIncomplete of bool * (string * bool) option * range
 
+/// Wrapper that adds a for-loop hint to an existing MatchIncomplete diagnostic.
+exception internal MatchIncompleteForLoopHint of exn
+
 exception internal RuleNeverMatched of range
 
 exception internal EnumMatchIncomplete of bool * (string * bool) option * range

src/Compiler/Driver/CompilerDiagnostics.fs

@@ -126,6 +126,7 @@ type Exception with
         | InterfaceNotRevealed(_, _, m)
         | WrappedError(_, m)
         | PatternMatchCompilation.MatchIncomplete(_, _, m)
+        | PatternMatchCompilation.MatchIncompleteForLoopHint(PatternMatchCompilation.MatchIncomplete(_, _, m))
         | PatternMatchCompilation.EnumMatchIncomplete(_, _, m)
         | PatternMatchCompilation.RuleNeverMatched m
         | ValNotMutable(_, _, m)
@@ -238,6 +239,7 @@ type Exception with
         | NameClash _ -> 23
         // 24 cannot be reused
         | PatternMatchCompilation.MatchIncomplete _ -> 25
+        | PatternMatchCompilation.MatchIncompleteForLoopHint _ -> 25
         | PatternMatchCompilation.RuleNeverMatched _ -> 26
 
         | ValNotMutable _ -> 27
@@ -449,7 +451,9 @@ module OldStyleMessages =
     let ConstraintSolverTypesNotInEqualityRelation2E () = Message("ConstraintSolverTypesNotInEqualityRelation2", "%s%s")
     let ConstraintSolverTypesNotInSubsumptionRelationE () = Message("ConstraintSolverTypesNotInSubsumptionRelation", "%s%s%s")
     let ErrorFromAddingTypeEquation1E () = Message("ErrorFromAddingTypeEquation1", "%s%s%s")
+    let ErrorFromAddingTypeEquation1TupleE () = Message("ErrorFromAddingTypeEquation1Tuple", "%s%s%s")
     let ErrorFromAddingTypeEquation2E () = Message("ErrorFromAddingTypeEquation2", "%s%s%s")
+    let ErrorFromAddingTypeEquation2TupleE () = Message("ErrorFromAddingTypeEquation2Tuple", "%s%s%s")
     let ErrorFromAddingTypeEquationTuplesE () = Message("ErrorFromAddingTypeEquationTuples", "%d%s%d%s%s")
     let ErrorFromApplyingDefault1E () = Message("ErrorFromApplyingDefault1", "%s")
     let ErrorFromApplyingDefault2E () = Message("ErrorFromApplyingDefault2", "")
@@ -564,6 +568,7 @@ module OldStyleMessages =
     let MatchIncomplete2E () = Message("MatchIncomplete2", "%s")
     let MatchIncomplete3E () = Message("MatchIncomplete3", "%s")
     let MatchIncomplete4E () = Message("MatchIncomplete4", "")
+    let MatchIncompleteForLoopE () = Message("MatchIncompleteForLoop", "")
     let RuleNeverMatchedE () = Message("RuleNeverMatched", "")
     let EnumMatchIncomplete1E () = Message("EnumMatchIncomplete1", "")
     let ValNotMutableE () = Message("ValNotMutable", "%s")
@@ -657,6 +662,8 @@ type Exception with
 
     member exn.Output(os: StringBuilder, suggestNames) =
 
+        let typeEquationMessage g ty2 normalE tupleE = if isAnyTupleTy g ty2 then tupleE else normalE
+
         match exn with
         // TODO: this is now unused...?
         | ConstraintSolverTupleDiffLengths(_, _, tl1, tl2, m, m2) ->
@@ -764,17 +771,20 @@ type Exception with
         | ErrorFromAddingTypeEquation(g, denv, ty1, ty2, ConstraintSolverTypesNotInEqualityRelation(_, ty1b, ty2b, m, _, contextInfo), _) when
             typeEquiv g ty1 ty1b && typeEquiv g ty2 ty2b
             ->
+            let typeEquation1E =
+                typeEquationMessage g ty2 ErrorFromAddingTypeEquation1E ErrorFromAddingTypeEquation1TupleE
+
             let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
 
             OutputTypesNotInEqualityRelationContextInfo contextInfo ty1 ty2 m os (fun contextInfo ->
                 match contextInfo with
                 | ContextInfo.TupleInRecordFields ->
-                    os.AppendString(ErrorFromAddingTypeEquation1E().Format ty2 ty1 tpcs)
+                    os.AppendString(typeEquation1E().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(typeEquation1E().Format ty2 ty1 tpcs)
                     os.AppendString(Environment.NewLine + FSComp.SR.derefInsteadOfNot ())
-                | _ -> os.AppendString(ErrorFromAddingTypeEquation1E().Format ty2 ty1 tpcs))
+                | _ -> os.AppendString(typeEquation1E().Format ty2 ty1 tpcs))
 
         | ErrorFromAddingTypeEquation(_, _, _, _, (ConstraintSolverTypesNotInEqualityRelation(_, _, _, _, _, contextInfo) as e), _) when
             (match contextInfo with
@@ -812,12 +822,15 @@ type Exception with
                     os.AppendString(SeeAlsoE().Format(stringOfRange m1))
 
         | ErrorFromAddingTypeEquation(g, denv, ty1, ty2, e, _) ->
+            let typeEquation2E =
+                typeEquationMessage g ty2 ErrorFromAddingTypeEquation2E ErrorFromAddingTypeEquation2TupleE
+
             let 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)
+                        os.AppendString(typeEquation2E().Format ty1 ty2 tpcs)
 
                     e
 
@@ -1009,11 +1022,13 @@ type Exception with
                 | Some name -> os.AppendString(FSComp.SR.notAFunctionButMaybeIndexerWithName2 name)
                 | _ -> os.AppendString(FSComp.SR.notAFunctionButMaybeIndexer2 ())
 
-        | NotAFunction(_, _, _, marg) ->
+        | NotAFunction(denv, ty, _, marg) ->
             if marg.StartColumn = 0 then
                 os.AppendString(FSComp.SR.notAFunctionButMaybeDeclaration ())
-            else
+            elif isTyparTy denv.g ty then
                 os.AppendString(FSComp.SR.notAFunction ())
+            else
+                os.AppendString(FSComp.SR.notAFunctionWithType (NicePrint.prettyStringOfTy denv ty))
 
         | TyconBadArgs(_, tcref, d, _) ->
             let exp = tcref.TyparsNoRange.Length
@@ -1789,6 +1804,19 @@ type Exception with
             if isComp then
                 os.AppendString(MatchIncomplete4E().Format)
 
+        | PatternMatchCompilation.MatchIncompleteForLoopHint(PatternMatchCompilation.MatchIncomplete(isComp, cexOpt, _)) ->
+            os.AppendString(MatchIncomplete1E().Format)
+
+            match cexOpt with
+            | None -> ()
+            | Some(cex, false) -> os.AppendString(MatchIncomplete2E().Format cex)
+            | Some(cex, true) -> os.AppendString(MatchIncomplete3E().Format cex)
+
+            os.AppendString(MatchIncompleteForLoopE().Format)
+
+            if isComp then
+                os.AppendString(MatchIncomplete4E().Format)
+
         | PatternMatchCompilation.EnumMatchIncomplete(isComp, cexOpt, _) ->
             os.AppendString(EnumMatchIncomplete1E().Format)