Keeping error context for tuple length mismatch

src/Compiler/Checking/CheckExpressions.fs

@@ -5815,7 +5815,7 @@ and CheckTupleIsCorrectLength g (env: TcEnv) m tupleTy (args: 'a list) tcArgs =
 
             // We let error recovery handle this exception
             error (ErrorFromAddingTypeEquation(g, env.DisplayEnv, tupleTy, expectedTy,
-                   (ConstraintSolverTupleDiffLengths(env.DisplayEnv, ptys, argTys, m, m)), m))
+                   (ConstraintSolverTupleDiffLengths(env.DisplayEnv, env.eContextInfo, ptys, argTys, m, m)), m))
 
 and TcExprTuple (cenv: cenv) overallTy env tpenv (isExplicitStruct, args, m) =
     let g = cenv.g

src/Compiler/Checking/ConstraintSolver.fs

@@ -232,7 +232,7 @@ type OverallTy =
         | MustEqual ty -> ty
         | MustConvertTo (_, ty) -> ty
 
-exception ConstraintSolverTupleDiffLengths of displayEnv: DisplayEnv * TType list * TType list * range * range
+exception ConstraintSolverTupleDiffLengths of displayEnv: DisplayEnv * contextInfo: ContextInfo * TType list * TType list * range * range
 
 exception ConstraintSolverInfiniteTypes of displayEnv: DisplayEnv * contextInfo: ContextInfo * TType * TType * range * range
 
@@ -1228,7 +1228,7 @@ and SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln origl1 origl2 =
            | h1 :: t1, h2 :: t2 when t1.Length = t2.Length -> 
                SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln h1 h2 ++ (fun () -> loop t1 t2) 
            | _ ->
-               ErrorD(ConstraintSolverTupleDiffLengths(csenv.DisplayEnv, origl1, origl2, csenv.m, m2)) 
+               ErrorD(ConstraintSolverTupleDiffLengths(csenv.DisplayEnv, csenv.eContextInfo, origl1, origl2, csenv.m, m2)) 
        loop origl1 origl2
 
 and SolveFunTypeEqn csenv ndeep m2 trace cxsln domainTy1 domainTy2 rangeTy1 rangeTy2 = trackErrors {

src/Compiler/Checking/ConstraintSolver.fsi

@@ -141,7 +141,13 @@ type OverallTy =
     /// Represents a point where no subsumption/widening is possible
     member Commit: TType
 
-exception ConstraintSolverTupleDiffLengths of displayEnv: DisplayEnv * TType list * TType list * range * range
+exception ConstraintSolverTupleDiffLengths of
+    displayEnv: DisplayEnv *
+    contextInfo: ContextInfo *
+    TType list *
+    TType list *
+    range *
+    range
 
 exception ConstraintSolverInfiniteTypes of
     displayEnv: DisplayEnv *

src/Compiler/Driver/CompilerDiagnostics.fs

@@ -170,7 +170,7 @@ type Exception with
         | VirtualAugmentationOnNullValuedType m
         | NonVirtualAugmentationOnNullValuedType m
         | NonRigidTypar (_, _, _, _, _, m)
-        | ConstraintSolverTupleDiffLengths (_, _, _, m, _)
+        | ConstraintSolverTupleDiffLengths (_, _, _, _, m, _)
         | ConstraintSolverInfiniteTypes (_, _, _, _, m, _)
         | ConstraintSolverMissingConstraint (_, _, _, m, _)
         | ConstraintSolverTypesNotInEqualityRelation (_, _, _, m, _, _)
@@ -617,12 +617,28 @@ let OutputNameSuggestions (os: StringBuilder) suggestNames suggestionsF idText =
                     os.AppendString "   "
                     os.AppendString(ConvertValLogicalNameToDisplayNameCore value)
 
+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
+
 type Exception with
 
     member exn.Output(os: StringBuilder, suggestNames) =
 
         match exn with
-        | ConstraintSolverTupleDiffLengths (_, tl1, tl2, m, m2) ->
+        // TODO: this is now unused...?
+        | ConstraintSolverTupleDiffLengths (_, _, tl1, tl2, m, m2) ->
             os.AppendString(ConstraintSolverTupleDiffLengthsE().Format tl1.Length tl2.Length)
 
             if m.StartLine <> m2.StartLine then
@@ -663,19 +679,8 @@ type Exception with
             // REVIEW: consider if we need to show _cxs (the type parameter constraints)
             let ty1, ty2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
 
-            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))
-            | _ -> os.AppendString(ConstraintSolverTypesNotInEqualityRelation2E().Format ty1 ty2)
+            OutputTypesNotInEqualityRelationContextInfo contextInfo ty1 ty2 m os (fun _ ->
+                os.AppendString(ConstraintSolverTypesNotInEqualityRelation2E().Format ty1 ty2))
 
             if m.StartLine <> m2.StartLine then
                 os.AppendString(SeeAlsoE().Format(stringOfRange m))
@@ -699,33 +704,15 @@ type Exception with
             ->
             let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
 
-            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.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)
+            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))
 
         | ErrorFromAddingTypeEquation (_, _, _, _, (ConstraintSolverTypesNotInEqualityRelation (_, _, _, _, _, contextInfo) as e), _) when
             (match contextInfo with
@@ -738,11 +725,23 @@ type Exception with
 
         | ErrorFromAddingTypeEquation(error = ConstraintSolverError _ as e) -> e.Output(os, suggestNames)
 
-        | ErrorFromAddingTypeEquation (_g, denv, ty1, ty2, ConstraintSolverTupleDiffLengths (_, tl1, tl2, _, _), _) ->
+        | ErrorFromAddingTypeEquation (_g, denv, ty1, ty2, ConstraintSolverTupleDiffLengths (_, contextInfo, tl1, tl2, _, _), m) ->
             let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
+            let messageArgs = tl1.Length, ty1, tl2.Length, ty2
 
             if ty1 <> ty2 + tpcs then
-                os.AppendString(ErrorFromAddingTypeEquationTuplesE().Format tl1.Length ty1 tl2.Length ty2 tpcs)
+                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)
 
         | ErrorFromAddingTypeEquation (g, denv, ty1, ty2, e, _) ->
             if not (typeEquiv g ty1 ty2) then
@@ -2107,7 +2106,7 @@ type PhasedDiagnostic with
             Printf.bprintf buf "\n"
 
             match e with
-            | FormattedDiagnostic.Short (_, txt) -> buf.AppendString txt |> ignore
+            | FormattedDiagnostic.Short (_, txt) -> buf.AppendString txt
             | FormattedDiagnostic.Long (_, details) ->
                 match details.Location with
                 | Some l when not l.IsEmpty -> buf.AppendString l.TextRepresentation

src/Compiler/FSComp.txt

@@ -19,11 +19,16 @@ undefinedNamePatternDiscriminator,"The pattern discriminator '%s' is not defined
 replaceWithSuggestion,"Replace with '%s'"
 addIndexerDot,"Add . for indexer access."
 listElementHasWrongType,"All elements of a list must be implicitly convertible to the type of the first element, which here is '%s'. This element has type '%s'."
+listElementHasWrongTypeTuple,"All elements of a list must be implicitly convertible to the type of the first element, which here is a tuple of length %d of type\n    %s    \nThis element is a tuple of length %d of type\n    %s    \n"
 arrayElementHasWrongType,"All elements of an array must be implicitly convertible to the type of the first element, which here is '%s'. This element has type '%s'."
+arrayElementHasWrongTypeTuple,"All elements of an array must be implicitly convertible to the type of the first element, which here is a tuple of length %d of type\n    %s    \nThis element is a tuple of length %d of type\n    %s    \n"
 missingElseBranch,"This 'if' expression is missing an 'else' branch. Because 'if' is an expression, and not a statement, add an 'else' branch which also returns a value of type '%s'."
 ifExpression,"The 'if' expression needs to have type '%s' to satisfy context type requirements. It currently has type '%s'."
+ifExpressionTuple,"The 'if' expression needs to return a tuple of length %d of type\n    %s    \nto satisfy context type requirements. It currently returns a tuple of length %d of type\n    %s    \n"
 elseBranchHasWrongType,"All branches of an 'if' expression must return values implicitly convertible to the type of the first branch, which here is '%s'. This branch returns a value of type '%s'."
+elseBranchHasWrongTypeTuple,"All branches of an 'if' expression must return values implicitly convertible to the type of the first branch, which here is a tuple of length %d of type\n    %s    \nThis branch returns a tuple of length %d of type\n    %s    \n"
 followingPatternMatchClauseHasWrongType,"All branches of a pattern match expression must return values implicitly convertible to the type of the first branch, which here is '%s'. This branch returns a value of type '%s'."
+followingPatternMatchClauseHasWrongTypeTuple,"All branches of a pattern match expression must return values implicitly convertible to the type of the first branch, which here is a tuple of length %d of type\n    %s    \nThis branch returns a tuple of length %d of type\n    %s    \n"
 patternMatchGuardIsNotBool,"A pattern match guard must be of type 'bool', but this 'when' expression is of type '%s'."
 commaInsteadOfSemicolonInRecord,"A ';' is used to separate field values in records. Consider replacing ',' with ';'."
 derefInsteadOfNot,"The '!' operator is used to dereference a ref cell. Consider using 'not expr' here."

src/Compiler/xlf/FSComp.txt.cs.xlf

@@ -2,6 +2,11 @@
 <xliff xmlns="urn:oasis:names:tc:xliff:document:1.2" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" version="1.2" xsi:schemaLocation="urn:oasis:names:tc:xliff:document:1.2 xliff-core-1.2-transitional.xsd">
   <file datatype="xml" source-language="en" target-language="cs" original="../FSComp.resx">
     <body>
+      <trans-unit id="arrayElementHasWrongTypeTuple">
+        <source>All elements of an array must be implicitly convertible to the type of the first element, which here is a tuple of length {0} of type\n    {1}    \nThis element is a tuple of length {2} of type\n    {3}    \n</source>
+        <target state="new">All elements of an array must be implicitly convertible to the type of the first element, which here is a tuple of length {0} of type\n    {1}    \nThis element is a tuple of length {2} of type\n    {3}    \n</target>
+        <note />
+      </trans-unit>
       <trans-unit id="buildInvalidSourceFileExtensionML">
         <source>The file extension of '{0}' is not recognized. Source files must have extension .fs, .fsi, .fsx or .fsscript. To enable the deprecated use of .ml or .mli extensions, use '--langversion:5.0' and '--mlcompatibility'.</source>
         <target state="translated">Soubor {0} má nerozpoznanou příponu. Zdrojové soubory musí mít příponu .fs, .fsi, .fsx nebo .fsscript. Pokud chcete povolit použití zastaralých přípon .ml nebo .mli, použijte parametry --langversion:5.0 a --mlcompatibility.</target>
@@ -107,6 +112,11 @@
         <target state="translated">Argument {0} neodpovídá</target>
         <note />
       </trans-unit>
+      <trans-unit id="elseBranchHasWrongTypeTuple">
+        <source>All branches of an 'if' expression must return values implicitly convertible to the type of the first branch, which here is a tuple of length {0} of type\n    {1}    \nThis branch returns a tuple of length {2} of type\n    {3}    \n</source>
+        <target state="new">All branches of an 'if' expression must return values implicitly convertible to the type of the first branch, which here is a tuple of length {0} of type\n    {1}    \nThis branch returns a tuple of length {2} of type\n    {3}    \n</target>
+        <note />
+      </trans-unit>
       <trans-unit id="etProviderHasDesignerAssemblyDependency">
         <source>The type provider designer assembly '{0}' could not be loaded from folder '{1}' because a dependency was missing or could not loaded. All dependencies of the type provider designer assembly must be located in the same folder as that assembly. The exception reported was: {2} - {3}</source>
         <target state="translated">Navržené sestavení poskytovatele typu {0} nešlo načíst ze složky {1}, protože chyběla závislost nebo ji nešlo načíst. Všechny závislosti tohoto sestavení se musí nacházet ve stejné složce jako toto sestavení. Ohlášená výjimka: {2} – {3}</target>
@@ -317,6 +327,11 @@
         <target state="translated">Předávání kopie clusteru pro omezení vlastností v uvozovkách v jazyce F#</target>
         <note />
       </trans-unit>
+      <trans-unit id="followingPatternMatchClauseHasWrongTypeTuple">
+        <source>All branches of a pattern match expression must return values implicitly convertible to the type of the first branch, which here is a tuple of length {0} of type\n    {1}    \nThis branch returns a tuple of length {2} of type\n    {3}    \n</source>
+        <target state="new">All branches of a pattern match expression must return values implicitly convertible to the type of the first branch, which here is a tuple of length {0} of type\n    {1}    \nThis branch returns a tuple of length {2} of type\n    {3}    \n</target>
+        <note />
+      </trans-unit>
       <trans-unit id="forFormatInvalidForInterpolated">
         <source>Interpolated strings may not use '%' format specifiers unless each is given an expression, e.g. '%d{{1+1}}'.</source>
         <target state="translated">Interpolované řetězce nemůžou používat specifikátory formátu %, pokud se každému z nich nezadá nějaký výraz, např. %d{{1+1}}.</target>
@@ -357,6 +372,11 @@
         <target state="translated">Neplatná direktiva #{0} {1}</target>
         <note />
       </trans-unit>
+      <trans-unit id="ifExpressionTuple">
+        <source>The 'if' expression needs to return a tuple of length {0} of type\n    {1}    \nto satisfy context type requirements. It currently returns a tuple of length {2} of type\n    {3}    \n</source>
+        <target state="new">The 'if' expression needs to return a tuple of length {0} of type\n    {1}    \nto satisfy context type requirements. It currently returns a tuple of length {2} of type\n    {3}    \n</target>
+        <note />
+      </trans-unit>
       <trans-unit id="ilxGenUnknownDebugPoint">
         <source>Unknown debug point '{0}'. The available debug points are '{1}'.</source>
         <target state="translated">Neznámý bod ladění {0}. Dostupné body ladění jsou {1}.</target>
@@ -417,6 +437,11 @@
         <target state="translated">Neplatný interpolovaný řetězec. V interpolovaných výrazech se nedají použít řetězcové literály s trojitými uvozovkami. Zvažte možnost použít pro interpolovaný výraz explicitní vazbu let.</target>
         <note />
       </trans-unit>
+      <trans-unit id="listElementHasWrongTypeTuple">
+        <source>All elements of a list must be implicitly convertible to the type of the first element, which here is a tuple of length {0} of type\n    {1}    \nThis element is a tuple of length {2} of type\n    {3}    \n</source>
+        <target state="new">All elements of a list must be implicitly convertible to the type of the first element, which here is a tuple of length {0} of type\n    {1}    \nThis element is a tuple of length {2} of type\n    {3}    \n</target>
+        <note />
+      </trans-unit>
       <trans-unit id="matchNotAllowedForUnionCaseWithNoData">
         <source>Pattern discard is not allowed for union case that takes no data.</source>
         <target state="new">Pattern discard is not allowed for union case that takes no data.</target>