From f0274f6acd91577a4027a67e4e3990efdb22a937 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Wed, 22 Jun 2022 09:48:44 -1100 Subject: [PATCH 01/18] Wrong type is reported in type mismatch error --- src/Compiler/Checking/ConstraintSolver.fs | 27 ++++++++++--------- .../ErrorMessages/TypeMismatchTests.fs | 15 +++++++++++ 2 files changed, 29 insertions(+), 13 deletions(-) diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index cb70cd5835e..2791edc7e9f 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -1200,19 +1200,20 @@ and private SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln t | LocallyAbortOperationThatLosesAbbrevs -> ErrorD(ConstraintSolverTypesNotInEqualityRelation(csenv.DisplayEnv, ty1, ty2, csenv.m, m2, csenv.eContextInfo)) | err -> ErrorD err) -and SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln origl1 origl2 = - match origl1, origl2 with - | [], [] -> CompleteD - | _ -> - // We unwind Iterate2D by hand here for performance reasons. - let rec loop l1 l2 = - match l1, l2 with - | [], [] -> CompleteD - | h1 :: t1, h2 :: t2 -> - SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln h1 h2 ++ (fun () -> loop t1 t2) - | _ -> - ErrorD(ConstraintSolverTupleDiffLengths(csenv.DisplayEnv, origl1, origl2, csenv.m, m2)) - loop origl1 origl2 +and SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln origl1 origl2 = + match origl1, origl2 with + | [], [] -> CompleteD + | _ -> + // We unwind Iterate2D by hand here for performance reasons. + let rec loop l1 l2 = + match l1, l2 with + | [], [] -> CompleteD + | h1 :: t1, h2 :: t2 when t1.Length = t2.Length -> + SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln h1 h2 ++ (fun () -> loop t1 t2) + | _ -> + // It would be better to have an instance of FSharpType contained in the error somehow but until it's not implemented it'd be good to report the correct type. + ErrorD(ConstraintSolverTupleDiffLengths(csenv.DisplayEnv, origl1, origl2, csenv.m, m2)) + loop origl1 origl2 and SolveFunTypeEqn csenv ndeep m2 trace cxsln domainTy1 domainTy2 rangeTy1 rangeTy2 = trackErrors { do! SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln domainTy1 domainTy2 diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs index 24adc58d391..e3b2d991d3c 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs @@ -7,6 +7,21 @@ open FSharp.Test.Compiler module ``Type Mismatch`` = + [] + let ``type mistmach is reported when tupes have differing lenghts``() = + FSharp """ + let x: int * int * int = 1, "" + let x: int * string * int = "", 1 + let x: int * int = "", "", 1 + """ + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 1, Line 2, Col 27, Line 2, Col 32, "Type mismatch. Expecting a\n 'int * int * int' \nbut given a\n ''a * 'b' \nThe tuples have differing lengths of 3 and 2"); + (Error 1, Line 3, Col 30, Line 3, Col 35, "Type mismatch. Expecting a\n 'int * string * int' \nbut given a\n ''a * 'b' \nThe tuples have differing lengths of 3 and 2"); + (Error 1, Line 4, Col 21, Line 4, Col 30, "Type mismatch. Expecting a\n 'int * int' \nbut given a\n ''a * 'b * 'c' \nThe tuples have differing lengths of 2 and 3") + ] + [] let ``return Instead Of return!``() = FSharp """ From 4078e92d64cb4dab8ba949481c7a0c3dd100427f Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Thu, 8 Sep 2022 11:43:24 +0200 Subject: [PATCH 02/18] WIP --- src/Compiler/Checking/CheckExpressions.fs | 92 +++++++++++++------ src/Compiler/Checking/CheckPatterns.fs | 1 - src/Compiler/Checking/ConstraintSolver.fs | 6 +- src/Compiler/Checking/ConstraintSolver.fsi | 2 + src/Compiler/Facilities/DiagnosticsLogger.fs | 2 +- .../ErrorMessages/TypeMismatchTests.fs | 8 +- 6 files changed, 76 insertions(+), 35 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 537887747d6..40791449cfb 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -582,30 +582,6 @@ let ShrinkContext env oldRange newRange = if not (equals m oldRange) then env else { env with eContextInfo = ContextInfo.ElseBranchResult newRange } -/// Allow the inference of structness from the known type, e.g. -/// let (x: struct (int * int)) = (3,4) -let UnifyTupleTypeAndInferCharacteristics contextInfo (cenv: cenv) denv m knownTy isExplicitStruct ps = - let g = cenv.g - let tupInfo, ptys = - if isAnyTupleTy g knownTy then - let tupInfo, ptys = destAnyTupleTy g knownTy - let tupInfo = (if isExplicitStruct then tupInfoStruct else tupInfo) - let ptys = - if List.length ps = List.length ptys then ptys - else NewInferenceTypes g ps - tupInfo, ptys - else - mkTupInfo isExplicitStruct, NewInferenceTypes g ps - - let contextInfo = - match contextInfo with - | ContextInfo.RecordFields -> ContextInfo.TupleInRecordFields - | _ -> contextInfo - - let ty2 = TType_tuple (tupInfo, ptys) - AddCxTypeEqualsType contextInfo denv cenv.css m knownTy ty2 - tupInfo, ptys - // Allow inference of assembly-affinity and structness from the known type - even from another assembly. This is a rule of // the language design and allows effective cross-assembly use of anonymous types in some limited circumstances. let UnifyAnonRecdTypeAndInferCharacteristics contextInfo (cenv: cenv) denv m ty isExplicitStruct unsortedNames = @@ -5334,7 +5310,7 @@ and TcPropagatingExprLeafThenConvert (cenv: cenv) overallTy actualTy (env: TcEnv UnifyTypes cenv env m overallTy.Commit actualTy f () -/// Process a leaf construct, for cases where we propogate the overall type eagerly in +/// Process a leaf construct, for cases where we propagate the overall type eagerly in /// some cases. Then apply additional type-directed conversions. /// /// However in some cases favour propagating characteristics of the overall type. @@ -5785,14 +5761,78 @@ and TcExprLazy (cenv: cenv) overallTy env tpenv (synInnerExpr, m) = let expr = mkLazyDelayed g m innerTy (mkUnitDelayLambda g m innerExpr) expr, tpenv + +/// Allow the inference of structness from the known type, e.g. +/// let (x: struct (int * int)) = (3,4) +and UnifyTupleTypeAndInferCharacteristics contextInfo (cenv: cenv) denv m knownTy isExplicitStruct ps = + let g = cenv.g + let tupInfo, ptys = + if isAnyTupleTy g knownTy then + let tupInfo, ptys = destAnyTupleTy g knownTy + let tupInfo = (if isExplicitStruct then tupInfoStruct else tupInfo) + let ptys = + if List.length ps = List.length ptys then ptys + else NewInferenceTypes g ps + tupInfo, ptys + else + mkTupInfo isExplicitStruct, NewInferenceTypes g ps + + let contextInfo = + match contextInfo with + | ContextInfo.RecordFields -> ContextInfo.TupleInRecordFields + | _ -> contextInfo + + let ty2 = TType_tuple (tupInfo, ptys) + AddCxTypeEqualsType' contextInfo denv cenv.css m knownTy ty2 |> RaiseOperationResult + tupInfo, ptys + +/// Allow the inference of structness from the known type, e.g. +/// let (x: struct (int * int)) = (3,4) +and UnifyTupleTypeAndInferCharacteristics' env tpenv contextInfo (cenv: cenv) denv m knownTy isExplicitStruct ps = + let g = cenv.g + let tupInfo, ptys = + if isAnyTupleTy g knownTy then + let tupInfo, ptys = destAnyTupleTy g knownTy + let tupInfo = (if isExplicitStruct then tupInfoStruct else tupInfo) + let ptys = + if List.length ps = List.length ptys then ptys + else NewInferenceTypes g ps + tupInfo, ptys + else + mkTupInfo isExplicitStruct, NewInferenceTypes g ps + + let contextInfo = + match contextInfo with + | ContextInfo.RecordFields -> ContextInfo.TupleInRecordFields + | _ -> contextInfo + + // TcExprsWithFlexes + + let ty2 = TType_tuple (tupInfo, ptys) + match AddCxTypeEqualsType' contextInfo denv cenv.css m knownTy ty2 with + | ErrorResult(warnings, ErrorFromAddingTypeEquation(g, displayEnv, actualTy, expectedTy, ex, m)) -> + + let flexes = ptys |> List.map (fun _ -> false) + let argsR, _tpenv = TcExprsWithFlexes cenv env m tpenv flexes ptys ps + let fixedExpectedTy = + match mkAnyTupled g m tupInfo argsR ptys with + | TypedTree.Expr.Op (TOp.Tuple _, typeArgs, _, _) -> TType_tuple (mkTupInfo false, typeArgs) + | _ -> expectedTy + + ErrorResult(warnings, ErrorFromAddingTypeEquation(g, displayEnv, actualTy, fixedExpectedTy, ex, m)) + | x -> x + |> RaiseOperationResult + tupInfo, ptys + and TcExprTuple (cenv: cenv) overallTy env tpenv (isExplicitStruct, args, m) = let g = cenv.g TcPossiblyPropogatingExprLeafThenConvert (fun ty -> isAnyTupleTy g ty || isTyparTy g ty) cenv overallTy env m (fun overallTy -> - let tupInfo, argTys = UnifyTupleTypeAndInferCharacteristics env.eContextInfo cenv env.DisplayEnv m overallTy isExplicitStruct args + let tupInfo, argTys = UnifyTupleTypeAndInferCharacteristics' env tpenv env.eContextInfo cenv env.DisplayEnv m overallTy isExplicitStruct args let flexes = argTys |> List.map (fun _ -> false) let argsR, tpenv = TcExprsWithFlexes cenv env m tpenv flexes argTys args let expr = mkAnyTupled g m tupInfo argsR argTys + expr, tpenv ) diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index dccff65781b..ee6227aa99a 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -759,4 +759,3 @@ and TcPatLongIdentLiteral warnOnUpper (cenv: cenv) env vFlags patEnv ty (mLongId and TcPatterns warnOnUpper cenv env vFlags s argTys args = assert (List.length args = List.length argTys) List.mapFold (fun s (ty, pat) -> TcPat warnOnUpper cenv env None vFlags s ty pat) s (List.zip argTys args) - diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 7c5f62298e3..359bb5e3c4d 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -1228,7 +1228,6 @@ 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) | _ -> - // It would be better to have an instance of FSharpType contained in the error somehow but until it's not implemented it'd be good to report the correct type. ErrorD(ConstraintSolverTupleDiffLengths(csenv.DisplayEnv, origl1, origl2, csenv.m, m2)) loop origl1 origl2 @@ -3454,12 +3453,13 @@ let EliminateConstraintsForGeneralizedTypars (denv: DisplayEnv) css m (trace: Op // No error recovery here: we do that on a per-expression basis. //------------------------------------------------------------------------- -let AddCxTypeEqualsType contextInfo denv css m actual expected = +let AddCxTypeEqualsType' contextInfo denv css m actual expected = let csenv = MakeConstraintSolverEnv contextInfo css m denv PostponeOnFailedMemberConstraintResolution csenv NoTrace (fun csenv -> SolveTypeEqualsTypeWithReport csenv 0 m NoTrace None actual expected) ErrorD - |> RaiseOperationResult + +let AddCxTypeEqualsType contextInfo denv css m actual expected = AddCxTypeEqualsType' contextInfo denv css m actual expected |> RaiseOperationResult let UndoIfFailed f = let trace = Trace.New() diff --git a/src/Compiler/Checking/ConstraintSolver.fsi b/src/Compiler/Checking/ConstraintSolver.fsi index c45db538fc2..af001015f2f 100644 --- a/src/Compiler/Checking/ConstraintSolver.fsi +++ b/src/Compiler/Checking/ConstraintSolver.fsi @@ -266,6 +266,8 @@ val EliminateConstraintsForGeneralizedTypars: val CheckDeclaredTypars: DisplayEnv -> ConstraintSolverState -> range -> Typars -> Typars -> unit +val AddCxTypeEqualsType': ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> OperationResult + val AddCxTypeEqualsType: ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> unit val AddCxTypeEqualsTypeUndoIfFailed: DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index aebfd1cfd6e..23f17956e28 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -595,7 +595,7 @@ let conditionallySuppressErrorReporting cond f = //------------------------------------------------------------------------ // Errors as data: Sometimes we have to reify errors as data, e.g. if backtracking -/// The result type of a computational modality to colelct warnings and possibly fail +/// The result type of a computational modality to collect warnings and possibly fail [] type OperationResult<'T> = | OkResult of warnings: exn list * result: 'T diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs index e3b2d991d3c..e2d12a32c27 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs @@ -8,7 +8,7 @@ open FSharp.Test.Compiler module ``Type Mismatch`` = [] - let ``type mistmach is reported when tupes have differing lenghts``() = + let ``type mismatch is reported when tuples have differing lengths``() = FSharp """ let x: int * int * int = 1, "" let x: int * string * int = "", 1 @@ -17,9 +17,9 @@ module ``Type Mismatch`` = |> typecheck |> shouldFail |> withDiagnostics [ - (Error 1, Line 2, Col 27, Line 2, Col 32, "Type mismatch. Expecting a\n 'int * int * int' \nbut given a\n ''a * 'b' \nThe tuples have differing lengths of 3 and 2"); - (Error 1, Line 3, Col 30, Line 3, Col 35, "Type mismatch. Expecting a\n 'int * string * int' \nbut given a\n ''a * 'b' \nThe tuples have differing lengths of 3 and 2"); - (Error 1, Line 4, Col 21, Line 4, Col 30, "Type mismatch. Expecting a\n 'int * int' \nbut given a\n ''a * 'b * 'c' \nThe tuples have differing lengths of 2 and 3") + (Error 1, Line 2, Col 27, Line 2, Col 32, "Type mismatch. Expecting a\n 'int * int * int' \nbut given a\n 'int * string' \nThe tuples have differing lengths of 3 and 2"); + (Error 1, Line 3, Col 30, Line 3, Col 35, "Type mismatch. Expecting a\n 'int * string * int' \nbut given a\n 'string * int' \nThe tuples have differing lengths of 3 and 2"); + (Error 1, Line 4, Col 21, Line 4, Col 30, "Type mismatch. Expecting a\n 'int * int' \nbut given a\n 'string * string * int' \nThe tuples have differing lengths of 2 and 3") ] [] From 0882f49837312b1abf6e7a0975fefc3918e38d0f Mon Sep 17 00:00:00 2001 From: 0101 <0101@innit.cz> Date: Thu, 8 Sep 2022 14:46:28 +0200 Subject: [PATCH 03/18] still WIP --- src/Compiler/Checking/CheckExpressions.fs | 58 ++++++------------- src/Compiler/Checking/CheckExpressions.fsi | 1 + src/Compiler/Checking/CheckPatterns.fs | 2 +- .../LetBindings/Basic/Basic.fs | 2 +- 4 files changed, 21 insertions(+), 42 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 40791449cfb..2ffdd6ef21d 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -5761,10 +5761,9 @@ and TcExprLazy (cenv: cenv) overallTy env tpenv (synInnerExpr, m) = let expr = mkLazyDelayed g m innerTy (mkUnitDelayLambda g m innerExpr) expr, tpenv - /// Allow the inference of structness from the known type, e.g. /// let (x: struct (int * int)) = (3,4) -and UnifyTupleTypeAndInferCharacteristics contextInfo (cenv: cenv) denv m knownTy isExplicitStruct ps = +and UnifyTupleTypeAndInferCharacteristics contextInfo (cenv: cenv) denv m knownTy isExplicitStruct tcForErrorMessage ps = let g = cenv.g let tupInfo, ptys = if isAnyTupleTy g knownTy then @@ -5783,57 +5782,36 @@ and UnifyTupleTypeAndInferCharacteristics contextInfo (cenv: cenv) denv m knownT | _ -> contextInfo let ty2 = TType_tuple (tupInfo, ptys) - AddCxTypeEqualsType' contextInfo denv cenv.css m knownTy ty2 |> RaiseOperationResult - tupInfo, ptys - -/// Allow the inference of structness from the known type, e.g. -/// let (x: struct (int * int)) = (3,4) -and UnifyTupleTypeAndInferCharacteristics' env tpenv contextInfo (cenv: cenv) denv m knownTy isExplicitStruct ps = - let g = cenv.g - let tupInfo, ptys = - if isAnyTupleTy g knownTy then - let tupInfo, ptys = destAnyTupleTy g knownTy - let tupInfo = (if isExplicitStruct then tupInfoStruct else tupInfo) - let ptys = - if List.length ps = List.length ptys then ptys - else NewInferenceTypes g ps - tupInfo, ptys - else - mkTupInfo isExplicitStruct, NewInferenceTypes g ps - - let contextInfo = - match contextInfo with - | ContextInfo.RecordFields -> ContextInfo.TupleInRecordFields - | _ -> contextInfo - - // TcExprsWithFlexes - let ty2 = TType_tuple (tupInfo, ptys) - match AddCxTypeEqualsType' contextInfo denv cenv.css m knownTy ty2 with - | ErrorResult(warnings, ErrorFromAddingTypeEquation(g, displayEnv, actualTy, expectedTy, ex, m)) -> - - let flexes = ptys |> List.map (fun _ -> false) - let argsR, _tpenv = TcExprsWithFlexes cenv env m tpenv flexes ptys ps + let cxOperationResult = AddCxTypeEqualsType' contextInfo denv cenv.css m knownTy ty2 + match cxOperationResult, tcForErrorMessage with + // Try to type check the tuple values when there's an incorrect number of them + | ErrorResult(warnings, ErrorFromAddingTypeEquation(g, displayEnv, actualTy, expectedTy, (ConstraintSolverTupleDiffLengths _ as ex), m)), Some tcForErrorMessage -> + let fixedExpectedTy = - match mkAnyTupled g m tupInfo argsR ptys with - | TypedTree.Expr.Op (TOp.Tuple _, typeArgs, _, _) -> TType_tuple (mkTupInfo false, typeArgs) + match tcForErrorMessage (tupInfo, ptys) with + | Expr.Op (TOp.Tuple _, typeArgs, _, _) -> TType_tuple (mkTupInfo false, typeArgs) | _ -> expectedTy - + ErrorResult(warnings, ErrorFromAddingTypeEquation(g, displayEnv, actualTy, fixedExpectedTy, ex, m)) - | x -> x + | operationResult, _ -> operationResult |> RaiseOperationResult + tupInfo, ptys and TcExprTuple (cenv: cenv) overallTy env tpenv (isExplicitStruct, args, m) = let g = cenv.g - TcPossiblyPropogatingExprLeafThenConvert (fun ty -> isAnyTupleTy g ty || isTyparTy g ty) cenv overallTy env m (fun overallTy -> - let tupInfo, argTys = UnifyTupleTypeAndInferCharacteristics' env tpenv env.eContextInfo cenv env.DisplayEnv m overallTy isExplicitStruct args - + + let tcTuple (tupInfo, argTys) = let flexes = argTys |> List.map (fun _ -> false) let argsR, tpenv = TcExprsWithFlexes cenv env m tpenv flexes argTys args let expr = mkAnyTupled g m tupInfo argsR argTys - + expr, tpenv + + TcPossiblyPropogatingExprLeafThenConvert (fun ty -> isAnyTupleTy g ty || isTyparTy g ty) cenv overallTy env m (fun overallTy -> + UnifyTupleTypeAndInferCharacteristics env.eContextInfo cenv env.DisplayEnv m overallTy isExplicitStruct (Some (tcTuple >> fst)) args + |> tcTuple ) and TcExprArrayOrList (cenv: cenv) overallTy env tpenv (isArray, args, m) = diff --git a/src/Compiler/Checking/CheckExpressions.fsi b/src/Compiler/Checking/CheckExpressions.fsi index 0bbaca89177..08545d04696 100644 --- a/src/Compiler/Checking/CheckExpressions.fsi +++ b/src/Compiler/Checking/CheckExpressions.fsi @@ -871,6 +871,7 @@ val UnifyTupleTypeAndInferCharacteristics: m: range -> knownTy: TType -> isExplicitStruct: bool -> + tcForErrorMessage: (TupInfo * TTypes -> Expr) option -> 'T list -> TupInfo * TTypes diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index ee6227aa99a..6fb2a05bfbf 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -418,7 +418,7 @@ and TcPatAnds warnOnUpper cenv env vFlags patEnv ty pats m = and TcPatTuple warnOnUpper cenv env vFlags patEnv ty isExplicitStruct args m = let g = cenv.g try - let tupInfo, argTys = UnifyTupleTypeAndInferCharacteristics env.eContextInfo cenv env.DisplayEnv m ty isExplicitStruct args + let tupInfo, argTys = UnifyTupleTypeAndInferCharacteristics env.eContextInfo cenv env.DisplayEnv m ty isExplicitStruct None args let argsR, acc = TcPatterns warnOnUpper cenv env vFlags patEnv argTys args let phase2 values = TPat_tuple(tupInfo, List.map (fun f -> f values) argsR, argTys, m) phase2, acc diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/LetBindings/Basic/Basic.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/LetBindings/Basic/Basic.fs index fc9e36d748e..d16093d1c41 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/LetBindings/Basic/Basic.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/LetBindings/Basic/Basic.fs @@ -42,7 +42,7 @@ module Basic = |> verifyCompile |> shouldFail |> withDiagnostics [ - (Error 1, Line 5, Col 16, Line 5, Col 23, "Type mismatch. Expecting a\n ''a * 'b' \nbut given a\n ''a * 'b * 'c' \nThe tuples have differing lengths of 2 and 3") + (Error 1, Line 5, Col 16, Line 5, Col 23, "Type mismatch. Expecting a\n ''a * 'b' \nbut given a\n 'int * int * int' \nThe tuples have differing lengths of 2 and 3") ] // SOURCE=E_AttributesOnLet01.fs SCFLAGS="--test:ErrorRanges" # E_AttributesOnLet01.fs From 0d1ca761b75234f3ff76afa80fce9403d69d7bf7 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Fri, 9 Sep 2022 17:58:00 +0200 Subject: [PATCH 04/18] Simpler solution --- src/Compiler/Checking/CheckExpressions.fs | 78 +++++++------------ src/Compiler/Checking/CheckExpressions.fsi | 1 - src/Compiler/Checking/CheckPatterns.fs | 3 +- src/Compiler/Checking/ConstraintSolver.fs | 32 ++++---- src/Compiler/Checking/ConstraintSolver.fsi | 2 - src/Compiler/Driver/CompilerDiagnostics.fs | 16 ++++ .../ErrorMessages/TypeMismatchTests.fs | 59 ++++++++++---- 7 files changed, 109 insertions(+), 82 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 2ffdd6ef21d..4410cc0e3f7 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -582,6 +582,30 @@ let ShrinkContext env oldRange newRange = if not (equals m oldRange) then env else { env with eContextInfo = ContextInfo.ElseBranchResult newRange } +/// Allow the inference of structness from the known type, e.g. +/// let (x: struct (int * int)) = (3,4) +let UnifyTupleTypeAndInferCharacteristics contextInfo (cenv: cenv) denv m knownTy isExplicitStruct ps = + let g = cenv.g + let tupInfo, ptys = + if isAnyTupleTy g knownTy then + let tupInfo, ptys = destAnyTupleTy g knownTy + let tupInfo = (if isExplicitStruct then tupInfoStruct else tupInfo) + let ptys = + if List.length ps = List.length ptys then ptys + else NewInferenceTypes g ps + tupInfo, ptys + else + mkTupInfo isExplicitStruct, NewInferenceTypes g ps + + let contextInfo = + match contextInfo with + | ContextInfo.RecordFields -> ContextInfo.TupleInRecordFields + | _ -> contextInfo + + let ty2 = TType_tuple (tupInfo, ptys) + AddCxTypeEqualsType contextInfo denv cenv.css m knownTy ty2 + tupInfo, ptys + // Allow inference of assembly-affinity and structness from the known type - even from another assembly. This is a rule of // the language design and allows effective cross-assembly use of anonymous types in some limited circumstances. let UnifyAnonRecdTypeAndInferCharacteristics contextInfo (cenv: cenv) denv m ty isExplicitStruct unsortedNames = @@ -5322,7 +5346,7 @@ and TcPropagatingExprLeafThenConvert (cenv: cenv) overallTy actualTy (env: TcEnv /// - tuple (except if overallTy is a tuple type or a variable type that can become one) /// - anon record (except if overallTy is an anon record type or a variable type that can become one) /// - record (except if overallTy is requiresCtor || haveCtor or a record type or a variable type that can become one)) -and TcPossiblyPropogatingExprLeafThenConvert isPropagating (cenv: cenv) (overallTy: OverallTy) (env: TcEnv) m processExpr = +and TcPossiblyPropagatingExprLeafThenConvert isPropagating (cenv: cenv) (overallTy: OverallTy) (env: TcEnv) m processExpr = let g = cenv.g @@ -5500,7 +5524,7 @@ and TcExprUndelayed (cenv: cenv) (overallTy: OverallTy) env tpenv (synExpr: SynE | SynExpr.AnonRecd (isStruct, withExprOpt, unsortedFieldExprs, mWholeExpr) -> TcNonControlFlowExpr env <| fun env -> - TcPossiblyPropogatingExprLeafThenConvert (fun ty -> isAnonRecdTy g ty || isTyparTy g ty) cenv overallTy env mWholeExpr (fun overallTy -> + TcPossiblyPropagatingExprLeafThenConvert (fun ty -> isAnonRecdTy g ty || isTyparTy g ty) cenv overallTy env mWholeExpr (fun overallTy -> TcAnonRecdExpr cenv overallTy env tpenv (isStruct, withExprOpt, unsortedFieldExprs, mWholeExpr) ) @@ -5761,57 +5785,15 @@ and TcExprLazy (cenv: cenv) overallTy env tpenv (synInnerExpr, m) = let expr = mkLazyDelayed g m innerTy (mkUnitDelayLambda g m innerExpr) expr, tpenv -/// Allow the inference of structness from the known type, e.g. -/// let (x: struct (int * int)) = (3,4) -and UnifyTupleTypeAndInferCharacteristics contextInfo (cenv: cenv) denv m knownTy isExplicitStruct tcForErrorMessage ps = - let g = cenv.g - let tupInfo, ptys = - if isAnyTupleTy g knownTy then - let tupInfo, ptys = destAnyTupleTy g knownTy - let tupInfo = (if isExplicitStruct then tupInfoStruct else tupInfo) - let ptys = - if List.length ps = List.length ptys then ptys - else NewInferenceTypes g ps - tupInfo, ptys - else - mkTupInfo isExplicitStruct, NewInferenceTypes g ps - - let contextInfo = - match contextInfo with - | ContextInfo.RecordFields -> ContextInfo.TupleInRecordFields - | _ -> contextInfo - - let ty2 = TType_tuple (tupInfo, ptys) - - let cxOperationResult = AddCxTypeEqualsType' contextInfo denv cenv.css m knownTy ty2 - match cxOperationResult, tcForErrorMessage with - // Try to type check the tuple values when there's an incorrect number of them - | ErrorResult(warnings, ErrorFromAddingTypeEquation(g, displayEnv, actualTy, expectedTy, (ConstraintSolverTupleDiffLengths _ as ex), m)), Some tcForErrorMessage -> - - let fixedExpectedTy = - match tcForErrorMessage (tupInfo, ptys) with - | Expr.Op (TOp.Tuple _, typeArgs, _, _) -> TType_tuple (mkTupInfo false, typeArgs) - | _ -> expectedTy - - ErrorResult(warnings, ErrorFromAddingTypeEquation(g, displayEnv, actualTy, fixedExpectedTy, ex, m)) - | operationResult, _ -> operationResult - |> RaiseOperationResult - - tupInfo, ptys - and TcExprTuple (cenv: cenv) overallTy env tpenv (isExplicitStruct, args, m) = let g = cenv.g - - let tcTuple (tupInfo, argTys) = + TcPossiblyPropagatingExprLeafThenConvert (fun ty -> isAnyTupleTy g ty || isTyparTy g ty) cenv overallTy env m (fun overallTy -> + let tupInfo, argTys = UnifyTupleTypeAndInferCharacteristics env.eContextInfo cenv env.DisplayEnv m overallTy isExplicitStruct args + let flexes = argTys |> List.map (fun _ -> false) let argsR, tpenv = TcExprsWithFlexes cenv env m tpenv flexes argTys args let expr = mkAnyTupled g m tupInfo argsR argTys - expr, tpenv - - TcPossiblyPropogatingExprLeafThenConvert (fun ty -> isAnyTupleTy g ty || isTyparTy g ty) cenv overallTy env m (fun overallTy -> - UnifyTupleTypeAndInferCharacteristics env.eContextInfo cenv env.DisplayEnv m overallTy isExplicitStruct (Some (tcTuple >> fst)) args - |> tcTuple ) and TcExprArrayOrList (cenv: cenv) overallTy env tpenv (isArray, args, m) = @@ -5886,7 +5868,7 @@ and TcExprRecord (cenv: cenv) overallTy env tpenv (inherits, withExprOpt, synRec CallExprHasTypeSink cenv.tcSink (mWholeExpr, env.NameEnv, overallTy.Commit, env.AccessRights) let requiresCtor = (GetCtorShapeCounter env = 1) // Get special expression forms for constructors let haveCtor = Option.isSome inherits - TcPossiblyPropogatingExprLeafThenConvert (fun ty -> requiresCtor || haveCtor || isRecdTy g ty || isTyparTy g ty) cenv overallTy env mWholeExpr (fun overallTy -> + TcPossiblyPropagatingExprLeafThenConvert (fun ty -> requiresCtor || haveCtor || isRecdTy g ty || isTyparTy g ty) cenv overallTy env mWholeExpr (fun overallTy -> TcRecdExpr cenv overallTy env tpenv (inherits, withExprOpt, synRecdFields, mWholeExpr) ) diff --git a/src/Compiler/Checking/CheckExpressions.fsi b/src/Compiler/Checking/CheckExpressions.fsi index 08545d04696..0bbaca89177 100644 --- a/src/Compiler/Checking/CheckExpressions.fsi +++ b/src/Compiler/Checking/CheckExpressions.fsi @@ -871,7 +871,6 @@ val UnifyTupleTypeAndInferCharacteristics: m: range -> knownTy: TType -> isExplicitStruct: bool -> - tcForErrorMessage: (TupInfo * TTypes -> Expr) option -> 'T list -> TupInfo * TTypes diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index 6fb2a05bfbf..dccff65781b 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -418,7 +418,7 @@ and TcPatAnds warnOnUpper cenv env vFlags patEnv ty pats m = and TcPatTuple warnOnUpper cenv env vFlags patEnv ty isExplicitStruct args m = let g = cenv.g try - let tupInfo, argTys = UnifyTupleTypeAndInferCharacteristics env.eContextInfo cenv env.DisplayEnv m ty isExplicitStruct None args + let tupInfo, argTys = UnifyTupleTypeAndInferCharacteristics env.eContextInfo cenv env.DisplayEnv m ty isExplicitStruct args let argsR, acc = TcPatterns warnOnUpper cenv env vFlags patEnv argTys args let phase2 values = TPat_tuple(tupInfo, List.map (fun f -> f values) argsR, argTys, m) phase2, acc @@ -759,3 +759,4 @@ and TcPatLongIdentLiteral warnOnUpper (cenv: cenv) env vFlags patEnv ty (mLongId and TcPatterns warnOnUpper cenv env vFlags s argTys args = assert (List.length args = List.length argTys) List.mapFold (fun s (ty, pat) -> TcPat warnOnUpper cenv env None vFlags s ty pat) s (List.zip argTys args) + diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 359bb5e3c4d..fc00af6da5a 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -1217,19 +1217,20 @@ and private SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln t | LocallyAbortOperationThatLosesAbbrevs -> ErrorD(ConstraintSolverTypesNotInEqualityRelation(csenv.DisplayEnv, ty1, ty2, csenv.m, m2, csenv.eContextInfo)) | err -> ErrorD err) -and SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln origl1 origl2 = - match origl1, origl2 with - | [], [] -> CompleteD - | _ -> - // We unwind Iterate2D by hand here for performance reasons. - let rec loop l1 l2 = - match l1, l2 with - | [], [] -> CompleteD - | 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)) - loop origl1 origl2 +and SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln origl1 origl2 = + match origl1, origl2 with + | [], [] -> CompleteD + | _ -> + // We unwind Iterate2D by hand here for performance reasons. + let rec loop l1 l2 = + match l1, l2 with + | [], [] -> CompleteD + | h1 :: t1, h2 :: t2 when t1.Length = t2.Length -> + SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln h1 h2 ++ (fun () -> loop t1 t2) + | _ -> + // TODO: we should probably keep the ContextInfo here + ErrorD(ConstraintSolverTupleDiffLengths(csenv.DisplayEnv, origl1, origl2, csenv.m, m2)) + loop origl1 origl2 and SolveFunTypeEqn csenv ndeep m2 trace cxsln domainTy1 domainTy2 rangeTy1 rangeTy2 = trackErrors { do! SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln domainTy1 domainTy2 @@ -3453,13 +3454,12 @@ let EliminateConstraintsForGeneralizedTypars (denv: DisplayEnv) css m (trace: Op // No error recovery here: we do that on a per-expression basis. //------------------------------------------------------------------------- -let AddCxTypeEqualsType' contextInfo denv css m actual expected = +let AddCxTypeEqualsType contextInfo denv css m actual expected = let csenv = MakeConstraintSolverEnv contextInfo css m denv PostponeOnFailedMemberConstraintResolution csenv NoTrace (fun csenv -> SolveTypeEqualsTypeWithReport csenv 0 m NoTrace None actual expected) ErrorD - -let AddCxTypeEqualsType contextInfo denv css m actual expected = AddCxTypeEqualsType' contextInfo denv css m actual expected |> RaiseOperationResult + |> RaiseOperationResult let UndoIfFailed f = let trace = Trace.New() diff --git a/src/Compiler/Checking/ConstraintSolver.fsi b/src/Compiler/Checking/ConstraintSolver.fsi index af001015f2f..c45db538fc2 100644 --- a/src/Compiler/Checking/ConstraintSolver.fsi +++ b/src/Compiler/Checking/ConstraintSolver.fsi @@ -266,8 +266,6 @@ val EliminateConstraintsForGeneralizedTypars: val CheckDeclaredTypars: DisplayEnv -> ConstraintSolverState -> range -> Typars -> Typars -> unit -val AddCxTypeEqualsType': ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> OperationResult - val AddCxTypeEqualsType: ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> unit val AddCxTypeEqualsTypeUndoIfFailed: DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index a6e0450af3a..d162d2624e4 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -735,6 +735,22 @@ let OutputPhasedErrorR (os: StringBuilder) (diagnostic: PhasedDiagnostic) (canSu | ConstraintSolverError _ as e), _) -> OutputExceptionR os e + | ErrorFromAddingTypeEquation (_g, denv, ty1, ty2, ConstraintSolverTupleDiffLengths (_, tl1, tl2, _, _ ), _) -> + + let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 + + let rec isKnownType = function TType_var ({typar_solution = None}, _) -> false + | TType_var ({typar_solution = Some s}, _) -> isKnownType s + | _ -> true + + let formatTuple tl ty = + if tl |> List.exists isKnownType then + $"tuple of length {tl.Length} ({ty})" + else $"tuple of length {tl.Length}" + + if ty1 <> ty2 + tpcs then + os.AppendString(ErrorFromAddingTypeEquation2E().Format (formatTuple tl1 ty1) (formatTuple tl2 ty2) tpcs) + | ErrorFromAddingTypeEquation (g, denv, ty1, ty2, e, _) -> if not (typeEquiv g ty1 ty2) then let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs index e2d12a32c27..566b7945324 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs @@ -7,20 +7,51 @@ open FSharp.Test.Compiler module ``Type Mismatch`` = - [] - let ``type mismatch is reported when tuples have differing lengths``() = - FSharp """ - let x: int * int * int = 1, "" - let x: int * string * int = "", 1 - let x: int * int = "", "", 1 - """ - |> typecheck - |> shouldFail - |> withDiagnostics [ - (Error 1, Line 2, Col 27, Line 2, Col 32, "Type mismatch. Expecting a\n 'int * int * int' \nbut given a\n 'int * string' \nThe tuples have differing lengths of 3 and 2"); - (Error 1, Line 3, Col 30, Line 3, Col 35, "Type mismatch. Expecting a\n 'int * string * int' \nbut given a\n 'string * int' \nThe tuples have differing lengths of 3 and 2"); - (Error 1, Line 4, Col 21, Line 4, Col 30, "Type mismatch. Expecting a\n 'int * int' \nbut given a\n 'string * string * int' \nThe tuples have differing lengths of 2 and 3") - ] + module ``Different tuple lengths`` = + + [] + let ``Known type on the left``() = + FSharp """ +let x: int * int * int = 1, "" +let x: int * string * int = "", 1 +let x: int * int = "", "", 1 + """ + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 1, Line 2, Col 26, Line 2, Col 31, + "Type mismatch. Expecting a\n 'tuple of length 3 (int * int * int)' \nbut given a\n 'tuple of length 2' \n") + (Error 1, Line 3, Col 29, Line 3, Col 34, + "Type mismatch. Expecting a\n 'tuple of length 3 (int * string * int)' \nbut given a\n 'tuple of length 2' \n") + (Error 1, Line 4, Col 20, Line 4, Col 29, + "Type mismatch. Expecting a\n 'tuple of length 2 (int * int)' \nbut given a\n 'tuple of length 3' \n") + ] + + [] + let ``Known type on the right``() = + FSharp """ +let x : int * string = 1, "" +let a, b, c = x + """ + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 1, Line 3, Col 15, Line 3, Col 16, + "Type mismatch. Expecting a\n 'tuple of length 3' \nbut given a\n 'tuple of length 2 (int * string)' \n") + ] + + // TODO + let ``Else branch context``() = + FSharp """ +let f1(a, b, c) = + if true then (1, 2) else (a, b, c) + """ + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 1, Line 3, Col 30, Line 3, Col 39, + "All branches of an 'if' expression must return values implicitly convertible to the type of the first branch, which here is 'tuple of length 2 (int * int)'. This branch returns a value of type 'tuple of length 3'.") + ] [] let ``return Instead Of return!``() = From fc388458203f79bf0b0626fd9b366bab050894aa Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Fri, 9 Sep 2022 18:09:23 +0200 Subject: [PATCH 05/18] test update --- .../Conformance/DeclarationElements/LetBindings/Basic/Basic.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/LetBindings/Basic/Basic.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/LetBindings/Basic/Basic.fs index d16093d1c41..84e5dfa2253 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/LetBindings/Basic/Basic.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/LetBindings/Basic/Basic.fs @@ -42,7 +42,7 @@ module Basic = |> verifyCompile |> shouldFail |> withDiagnostics [ - (Error 1, Line 5, Col 16, Line 5, Col 23, "Type mismatch. Expecting a\n ''a * 'b' \nbut given a\n 'int * int * int' \nThe tuples have differing lengths of 2 and 3") + (Error 1, Line 5, Col 16, Line 5, Col 23, "Type mismatch. Expecting a\n 'tuple of length 2' \nbut given a\n 'tuple of length 3' \n") ] // SOURCE=E_AttributesOnLet01.fs SCFLAGS="--test:ErrorRanges" # E_AttributesOnLet01.fs From cf11713d1f92a862139ed8be6d8a9de759350c51 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20Pokorn=C3=BD?= Date: Thu, 22 Sep 2022 16:42:42 +0200 Subject: [PATCH 06/18] Detecting tuple length mismatch early and type checking the RHS --- src/Compiler/Checking/CheckExpressions.fs | 18 +++++++++ src/Compiler/Driver/CompilerDiagnostics.fs | 14 ++----- src/Compiler/FSStrings.resx | 7 +++- src/Compiler/xlf/FSStrings.cs.xlf | 5 +++ src/Compiler/xlf/FSStrings.de.xlf | 5 +++ src/Compiler/xlf/FSStrings.es.xlf | 5 +++ src/Compiler/xlf/FSStrings.fr.xlf | 5 +++ src/Compiler/xlf/FSStrings.it.xlf | 5 +++ src/Compiler/xlf/FSStrings.ja.xlf | 5 +++ src/Compiler/xlf/FSStrings.ko.xlf | 5 +++ src/Compiler/xlf/FSStrings.pl.xlf | 5 +++ src/Compiler/xlf/FSStrings.pt-BR.xlf | 5 +++ src/Compiler/xlf/FSStrings.ru.xlf | 5 +++ src/Compiler/xlf/FSStrings.tr.xlf | 5 +++ src/Compiler/xlf/FSStrings.zh-Hans.xlf | 5 +++ src/Compiler/xlf/FSStrings.zh-Hant.xlf | 5 +++ .../ErrorMessages/TypeMismatchTests.fs | 37 +++++++++---------- 17 files changed, 109 insertions(+), 32 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index a15bd96a712..19661f0ca33 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -603,6 +603,7 @@ let UnifyTupleTypeAndInferCharacteristics contextInfo (cenv: cenv) denv m knownT | _ -> contextInfo let ty2 = TType_tuple (tupInfo, ptys) + AddCxTypeEqualsType contextInfo denv cenv.css m knownTy ty2 tupInfo, ptys @@ -5792,6 +5793,23 @@ and TcExprLazy (cenv: cenv) overallTy env tpenv (synInnerExpr, m) = and TcExprTuple (cenv: cenv) overallTy env tpenv (isExplicitStruct, args, m) = let g = cenv.g TcPossiblyPropagatingExprLeafThenConvert (fun ty -> isAnyTupleTy g ty || isTyparTy g ty) cenv overallTy env m (fun overallTy -> + + // We preemptively check if the tuple has the correct length before submitting it to the + // constraint solver. If not we type check it against empty inference variables so that + // we can show the types in the error message if they are known. + if isAnyTupleTy g overallTy then + let tupInfo, ptys = destAnyTupleTy g overallTy + + if List.length args <> List.length ptys then + let rhsTys = NewInferenceTypes g args + let flexes = rhsTys |> List.map (fun _ -> false) + suppressErrorReporting (fun () -> TcExprsWithFlexes cenv env m tpenv flexes rhsTys args) |> ignore + let expectedTy = TType_tuple (tupInfo, rhsTys) + + // We let error recovery handle this exception + error (ErrorFromAddingTypeEquation(g, env.DisplayEnv, overallTy, expectedTy, + (ConstraintSolverTupleDiffLengths(env.DisplayEnv, ptys, rhsTys, m, m)), m)) + let tupInfo, argTys = UnifyTupleTypeAndInferCharacteristics env.eContextInfo cenv env.DisplayEnv m overallTy isExplicitStruct args let flexes = argTys |> List.map (fun _ -> false) diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index e0e346e4523..64ab01c6e3b 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -439,6 +439,7 @@ module OldStyleMessages = let ConstraintSolverTypesNotInSubsumptionRelationE () = Message("ConstraintSolverTypesNotInSubsumptionRelation", "%s%s%s") let ErrorFromAddingTypeEquation1E () = Message("ErrorFromAddingTypeEquation1", "%s%s%s") let ErrorFromAddingTypeEquation2E () = Message("ErrorFromAddingTypeEquation2", "%s%s%s") + let ErrorFromAddingTypeEquationTuplesE () = Message("ErrorFromAddingTypeEquationTuples", "%d%s%d%s%s") let ErrorFromApplyingDefault1E () = Message("ErrorFromApplyingDefault1", "%s") let ErrorFromApplyingDefault2E () = Message("ErrorFromApplyingDefault2", "") let ErrorsFromAddingSubsumptionConstraintE () = Message("ErrorsFromAddingSubsumptionConstraint", "%s%s%s") @@ -739,18 +740,9 @@ type Exception with | ErrorFromAddingTypeEquation (_g, denv, ty1, ty2, ConstraintSolverTupleDiffLengths (_, tl1, tl2, _, _ ), _) -> let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 - - let rec isKnownType = function TType_var ({typar_solution = None}, _) -> false - | TType_var ({typar_solution = Some s}, _) -> isKnownType s - | _ -> true - - let formatTuple tl ty = - if tl |> List.exists isKnownType then - $"tuple of length {tl.Length} ({ty})" - else $"tuple of length {tl.Length}" - + if ty1 <> ty2 + tpcs then - os.AppendString(ErrorFromAddingTypeEquation2E().Format (formatTuple tl1 ty1) (formatTuple tl2 ty2) tpcs) + os.AppendString(ErrorFromAddingTypeEquationTuplesE().Format tl1.Length ty1 tl2.Length ty2 tpcs) | ErrorFromAddingTypeEquation (g, denv, ty1, ty2, e, _) -> if not (typeEquiv g ty1 ty2) then diff --git a/src/Compiler/FSStrings.resx b/src/Compiler/FSStrings.resx index 51f172fbbea..7616276cc99 100644 --- a/src/Compiler/FSStrings.resx +++ b/src/Compiler/FSStrings.resx @@ -573,7 +573,7 @@ keyword 'and' - ! + keyword 'and!' @@ -907,7 +907,7 @@ This expression is a function value, i.e. is missing arguments. Its type is {0}. - The result of this expression has type '{0}' and is implicitly ignored. Consider using 'ignore' to discard this value explicitly, e.g. 'expr |> ignore', or 'let' to bind the result to a name, e.g. 'let result = expr'. + The result of this expression has type '{0}' and is implicitly ignored. Consider using 'ignore' to discard this value explicitly, e.g. 'expr |> ignore', or 'let' to bind the result to a name, e.g. 'let result = expr'. The result of this equality expression has type '{0}' and is implicitly discarded. Consider using 'let' to bind the result to a name, e.g. 'let result = expression'. @@ -1110,4 +1110,7 @@ Lowercase discriminated union cases are only allowed when using RequireQualifiedAccess attribute + + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + \ No newline at end of file diff --git a/src/Compiler/xlf/FSStrings.cs.xlf b/src/Compiler/xlf/FSStrings.cs.xlf index f80da09f758..9ae4a01d0df 100644 --- a/src/Compiler/xlf/FSStrings.cs.xlf +++ b/src/Compiler/xlf/FSStrings.cs.xlf @@ -2,6 +2,11 @@ + + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + + One or more informational messages in loaded file.\n Nejméně jedna informační zpráva v načteném souboru\n diff --git a/src/Compiler/xlf/FSStrings.de.xlf b/src/Compiler/xlf/FSStrings.de.xlf index 8978b176751..3701029f76a 100644 --- a/src/Compiler/xlf/FSStrings.de.xlf +++ b/src/Compiler/xlf/FSStrings.de.xlf @@ -2,6 +2,11 @@ + + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + + One or more informational messages in loaded file.\n Mindestens eine Informationsmeldung in der geladenen Datei.\n diff --git a/src/Compiler/xlf/FSStrings.es.xlf b/src/Compiler/xlf/FSStrings.es.xlf index bc0ce4ad5a8..d836ca97b1e 100644 --- a/src/Compiler/xlf/FSStrings.es.xlf +++ b/src/Compiler/xlf/FSStrings.es.xlf @@ -2,6 +2,11 @@ + + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + + One or more informational messages in loaded file.\n Uno o más mensajes informativos en el archivo cargado.\n diff --git a/src/Compiler/xlf/FSStrings.fr.xlf b/src/Compiler/xlf/FSStrings.fr.xlf index f88d8e7182b..aba1f520dc8 100644 --- a/src/Compiler/xlf/FSStrings.fr.xlf +++ b/src/Compiler/xlf/FSStrings.fr.xlf @@ -2,6 +2,11 @@ + + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + + One or more informational messages in loaded file.\n Un ou plusieurs messages d’information dans le fichier chargé.\n diff --git a/src/Compiler/xlf/FSStrings.it.xlf b/src/Compiler/xlf/FSStrings.it.xlf index 90d7b1611ff..b0a0bb8a1a6 100644 --- a/src/Compiler/xlf/FSStrings.it.xlf +++ b/src/Compiler/xlf/FSStrings.it.xlf @@ -2,6 +2,11 @@ + + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + + One or more informational messages in loaded file.\n Uno o più messaggi informativi nel file caricato.\n diff --git a/src/Compiler/xlf/FSStrings.ja.xlf b/src/Compiler/xlf/FSStrings.ja.xlf index b0a149427b1..7259d209c4e 100644 --- a/src/Compiler/xlf/FSStrings.ja.xlf +++ b/src/Compiler/xlf/FSStrings.ja.xlf @@ -2,6 +2,11 @@ + + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + + One or more informational messages in loaded file.\n 読み込まれたファイル内の 1 つ以上の情報メッセージ。\n diff --git a/src/Compiler/xlf/FSStrings.ko.xlf b/src/Compiler/xlf/FSStrings.ko.xlf index 95015040f09..df894d6e464 100644 --- a/src/Compiler/xlf/FSStrings.ko.xlf +++ b/src/Compiler/xlf/FSStrings.ko.xlf @@ -2,6 +2,11 @@ + + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + + One or more informational messages in loaded file.\n 로드된 파일에 하나 이상의 정보 메시지가 있습니다.\n diff --git a/src/Compiler/xlf/FSStrings.pl.xlf b/src/Compiler/xlf/FSStrings.pl.xlf index 48a2f8adedc..c013efe5e25 100644 --- a/src/Compiler/xlf/FSStrings.pl.xlf +++ b/src/Compiler/xlf/FSStrings.pl.xlf @@ -2,6 +2,11 @@ + + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + + One or more informational messages in loaded file.\n Jeden lub więcej komunikatów informacyjnych w załadowanym pliku.\n diff --git a/src/Compiler/xlf/FSStrings.pt-BR.xlf b/src/Compiler/xlf/FSStrings.pt-BR.xlf index 1929c486cda..cbfdb3d9571 100644 --- a/src/Compiler/xlf/FSStrings.pt-BR.xlf +++ b/src/Compiler/xlf/FSStrings.pt-BR.xlf @@ -2,6 +2,11 @@ + + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + + One or more informational messages in loaded file.\n Uma ou mais mensagens informativas no arquivo carregado.\n diff --git a/src/Compiler/xlf/FSStrings.ru.xlf b/src/Compiler/xlf/FSStrings.ru.xlf index 1e91c13cd4c..2e5990bf60a 100644 --- a/src/Compiler/xlf/FSStrings.ru.xlf +++ b/src/Compiler/xlf/FSStrings.ru.xlf @@ -2,6 +2,11 @@ + + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + + One or more informational messages in loaded file.\n Одно или несколько информационных сообщений в загруженном файле.\n diff --git a/src/Compiler/xlf/FSStrings.tr.xlf b/src/Compiler/xlf/FSStrings.tr.xlf index 31b4cad81af..f39a7c98226 100644 --- a/src/Compiler/xlf/FSStrings.tr.xlf +++ b/src/Compiler/xlf/FSStrings.tr.xlf @@ -2,6 +2,11 @@ + + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + + One or more informational messages in loaded file.\n Yüklenen dosyada bir veya daha fazla bilgi mesajı.\n diff --git a/src/Compiler/xlf/FSStrings.zh-Hans.xlf b/src/Compiler/xlf/FSStrings.zh-Hans.xlf index be3604df4bf..4e165af368e 100644 --- a/src/Compiler/xlf/FSStrings.zh-Hans.xlf +++ b/src/Compiler/xlf/FSStrings.zh-Hans.xlf @@ -2,6 +2,11 @@ + + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + + One or more informational messages in loaded file.\n 加载文件 .\n 中有一条或多条信息性消息 diff --git a/src/Compiler/xlf/FSStrings.zh-Hant.xlf b/src/Compiler/xlf/FSStrings.zh-Hant.xlf index 67e6c25370e..0539395909b 100644 --- a/src/Compiler/xlf/FSStrings.zh-Hant.xlf +++ b/src/Compiler/xlf/FSStrings.zh-Hant.xlf @@ -2,6 +2,11 @@ + + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + Type mismatch. Expecting a tuple of length {0} of type\n {1} \nbut given a tuple of length {2} of type\n {3} {4}\n + + One or more informational messages in loaded file.\n 已載入檔案中的一或多個資訊訊息。\n diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs index 566b7945324..8025a7f7746 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs @@ -8,25 +8,19 @@ open FSharp.Test.Compiler module ``Type Mismatch`` = module ``Different tuple lengths`` = - + [] let ``Known type on the left``() = FSharp """ -let x: int * int * int = 1, "" -let x: int * string * int = "", 1 -let x: int * int = "", "", 1 +let x a b c : int * int = a, b, c """ |> typecheck |> shouldFail |> withDiagnostics [ - (Error 1, Line 2, Col 26, Line 2, Col 31, - "Type mismatch. Expecting a\n 'tuple of length 3 (int * int * int)' \nbut given a\n 'tuple of length 2' \n") - (Error 1, Line 3, Col 29, Line 3, Col 34, - "Type mismatch. Expecting a\n 'tuple of length 3 (int * string * int)' \nbut given a\n 'tuple of length 2' \n") - (Error 1, Line 4, Col 20, Line 4, Col 29, - "Type mismatch. Expecting a\n 'tuple of length 2 (int * int)' \nbut given a\n 'tuple of length 3' \n") + (Error 1, Line 2, Col 27, Line 2, Col 34, + "Type mismatch. Expecting a tuple of length 2 of type\n int * int \nbut given a tuple of length 3 of type\n 'a * 'b * 'c \n") ] - + [] let ``Known type on the right``() = FSharp """ @@ -37,20 +31,25 @@ let a, b, c = x |> shouldFail |> withDiagnostics [ (Error 1, Line 3, Col 15, Line 3, Col 16, - "Type mismatch. Expecting a\n 'tuple of length 3' \nbut given a\n 'tuple of length 2 (int * string)' \n") + "Type mismatch. Expecting a tuple of length 3 of type\n 'a * 'b * 'c \nbut given a tuple of length 2 of type\n int * string \n") ] - - // TODO - let ``Else branch context``() = + + [] + let ``Known types on both sides``() = FSharp """ -let f1(a, b, c) = - if true then (1, 2) else (a, b, c) +let x: int * int * int = 1, "" +let x: int * string * int = "", 1 +let x: int * int = "", "", 1 """ |> typecheck |> shouldFail |> withDiagnostics [ - (Error 1, Line 3, Col 30, Line 3, Col 39, - "All branches of an 'if' expression must return values implicitly convertible to the type of the first branch, which here is 'tuple of length 2 (int * int)'. This branch returns a value of type 'tuple of length 3'.") + (Error 1, Line 2, Col 26, Line 2, Col 31, + "Type mismatch. Expecting a tuple of length 3 of type\n int * int * int \nbut given a tuple of length 2 of type\n int * string \n") + (Error 1, Line 3, Col 29, Line 3, Col 34, + "Type mismatch. Expecting a tuple of length 3 of type\n int * string * int \nbut given a tuple of length 2 of type\n string * int \n") + (Error 1, Line 4, Col 20, Line 4, Col 29, + "Type mismatch. Expecting a tuple of length 2 of type\n int * int \nbut given a tuple of length 3 of type\n string * string * int \n") ] [] From 5d832201f82c57e15204264a5f601ed3e4d4e949 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20Pokorn=C3=BD?= Date: Thu, 22 Sep 2022 16:47:51 +0200 Subject: [PATCH 07/18] fantomas --- src/Compiler/Driver/CompilerDiagnostics.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 64ab01c6e3b..7da2a668d99 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -737,13 +737,13 @@ 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 (_, tl1, tl2, _, _), _) -> + let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 if ty1 <> ty2 + tpcs then os.AppendString(ErrorFromAddingTypeEquationTuplesE().Format tl1.Length ty1 tl2.Length ty2 tpcs) - + | ErrorFromAddingTypeEquation (g, denv, ty1, ty2, e, _) -> if not (typeEquiv g ty1 ty2) then let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 From 756357e118baf45513c278a408ecfd92b2e4f039 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Petr=20Pokorn=C3=BD?= Date: Thu, 22 Sep 2022 17:02:53 +0200 Subject: [PATCH 08/18] Test update --- .../Conformance/DeclarationElements/LetBindings/Basic/Basic.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/LetBindings/Basic/Basic.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/LetBindings/Basic/Basic.fs index 84e5dfa2253..aace49ba0d7 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/LetBindings/Basic/Basic.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/DeclarationElements/LetBindings/Basic/Basic.fs @@ -42,7 +42,7 @@ module Basic = |> verifyCompile |> shouldFail |> withDiagnostics [ - (Error 1, Line 5, Col 16, Line 5, Col 23, "Type mismatch. Expecting a\n 'tuple of length 2' \nbut given a\n 'tuple of length 3' \n") + (Error 1, Line 5, Col 16, Line 5, Col 23, "Type mismatch. Expecting a tuple of length 2 of type\n 'a * 'b \nbut given a tuple of length 3 of type\n int * int * int \n") ] // SOURCE=E_AttributesOnLet01.fs SCFLAGS="--test:ErrorRanges" # E_AttributesOnLet01.fs From 656c24891133a04c413ab8b2fd015857ae46074d Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Thu, 22 Sep 2022 17:10:15 +0200 Subject: [PATCH 09/18] Remove comment --- src/Compiler/Checking/ConstraintSolver.fs | 1 - src/Compiler/Driver/CompilerDiagnostics.fs | 2 -- 2 files changed, 3 deletions(-) diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 384d7a4e92d..9f35a8a52aa 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -1228,7 +1228,6 @@ 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) | _ -> - // TODO: we should probably keep the ContextInfo here ErrorD(ConstraintSolverTupleDiffLengths(csenv.DisplayEnv, origl1, origl2, csenv.m, m2)) loop origl1 origl2 diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 7da2a668d99..02934061602 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -738,9 +738,7 @@ type Exception with | ErrorFromAddingTypeEquation(error = ConstraintSolverError _ as e) -> e.Output(os, suggestNames) | ErrorFromAddingTypeEquation (_g, denv, ty1, ty2, ConstraintSolverTupleDiffLengths (_, tl1, tl2, _, _), _) -> - let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 - if ty1 <> ty2 + tpcs then os.AppendString(ErrorFromAddingTypeEquationTuplesE().Format tl1.Length ty1 tl2.Length ty2 tpcs) From 0e2b146af4b4f56bd242fa0117bd45bd6aa97290 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Thu, 22 Sep 2022 17:12:36 +0200 Subject: [PATCH 10/18] Undo whitespace change --- src/Compiler/Checking/CheckExpressions.fs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 19661f0ca33..0cdf33cb218 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -603,7 +603,6 @@ let UnifyTupleTypeAndInferCharacteristics contextInfo (cenv: cenv) denv m knownT | _ -> contextInfo let ty2 = TType_tuple (tupInfo, ptys) - AddCxTypeEqualsType contextInfo denv cenv.css m knownTy ty2 tupInfo, ptys From dd248b010a51c453e4bb34870cdd5858d459fc0c Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Tue, 27 Sep 2022 13:53:08 +0200 Subject: [PATCH 11/18] Tuple length mismatch in patterns --- src/Compiler/Checking/CheckExpressions.fs | 51 +++++++++---------- src/Compiler/Checking/CheckExpressions.fsi | 12 +++++ src/Compiler/Checking/CheckPatterns.fs | 2 + .../ErrorMessages/TypeMismatchTests.fs | 37 ++++++++++++++ .../Tuple/E_TupleMismatch01.fs | 15 ------ .../Conformance/PatternMatching/Tuple/env.lst | 4 +- 6 files changed, 77 insertions(+), 44 deletions(-) delete mode 100644 tests/fsharpqa/Source/Conformance/PatternMatching/Tuple/E_TupleMismatch01.fs diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 0cdf33cb218..22c86ee6ef5 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -590,8 +590,8 @@ let UnifyTupleTypeAndInferCharacteristics contextInfo (cenv: cenv) denv m knownT if isAnyTupleTy g knownTy then let tupInfo, ptys = destAnyTupleTy g knownTy let tupInfo = (if isExplicitStruct then tupInfoStruct else tupInfo) - let ptys = - if List.length ps = List.length ptys then ptys + let ptys = + if List.length ps = List.length ptys then ptys else NewInferenceTypes g ps tupInfo, ptys else @@ -5283,6 +5283,11 @@ and TcExprsWithFlexes (cenv: cenv) env m tpenv flexes argTys args = (tpenv, List.zip3 flexes argTys args) ||> List.mapFold (fun tpenv (flex, ty, e) -> TcExprFlex cenv flex false ty env tpenv e) +and TcExprsNoFlexes (cenv: cenv) env m tpenv argTys args = + if List.length args <> List.length argTys then error(Error(FSComp.SR.tcExpressionCountMisMatch((List.length argTys), (List.length args)), m)) + (tpenv, List.zip argTys args) ||> List.mapFold (fun tpenv (ty, e) -> + TcExprFlex2 cenv ty env false tpenv e) + and CheckSuperInit (cenv: cenv) objTy m = let g = cenv.g @@ -5789,30 +5794,27 @@ and TcExprLazy (cenv: cenv) overallTy env tpenv (synInnerExpr, m) = let expr = mkLazyDelayed g m innerTy (mkUnitDelayLambda g m innerExpr) expr, tpenv +and CheckTupleIsCorrectLength g (env: TcEnv) m tupleTy args typeCheckArgs = + if isAnyTupleTy g tupleTy then + let tupInfo, ptys = destAnyTupleTy g tupleTy + + if List.length args <> List.length ptys then + let argTys = NewInferenceTypes g args + suppressErrorReporting (fun () -> typeCheckArgs argTys) + let expectedTy = TType_tuple (tupInfo, argTys) + + // We let error recovery handle this exception + error (ErrorFromAddingTypeEquation(g, env.DisplayEnv, tupleTy, expectedTy, + (ConstraintSolverTupleDiffLengths(env.DisplayEnv, ptys, argTys, m, m)), m)) + and TcExprTuple (cenv: cenv) overallTy env tpenv (isExplicitStruct, args, m) = let g = cenv.g TcPossiblyPropagatingExprLeafThenConvert (fun ty -> isAnyTupleTy g ty || isTyparTy g ty) cenv overallTy env m (fun overallTy -> - // We preemptively check if the tuple has the correct length before submitting it to the - // constraint solver. If not we type check it against empty inference variables so that - // we can show the types in the error message if they are known. - if isAnyTupleTy g overallTy then - let tupInfo, ptys = destAnyTupleTy g overallTy - - if List.length args <> List.length ptys then - let rhsTys = NewInferenceTypes g args - let flexes = rhsTys |> List.map (fun _ -> false) - suppressErrorReporting (fun () -> TcExprsWithFlexes cenv env m tpenv flexes rhsTys args) |> ignore - let expectedTy = TType_tuple (tupInfo, rhsTys) - - // We let error recovery handle this exception - error (ErrorFromAddingTypeEquation(g, env.DisplayEnv, overallTy, expectedTy, - (ConstraintSolverTupleDiffLengths(env.DisplayEnv, ptys, rhsTys, m, m)), m)) + CheckTupleIsCorrectLength g env m overallTy args (fun argTys -> TcExprsNoFlexes cenv env m tpenv argTys args |> ignore) let tupInfo, argTys = UnifyTupleTypeAndInferCharacteristics env.eContextInfo cenv env.DisplayEnv m overallTy isExplicitStruct args - - let flexes = argTys |> List.map (fun _ -> false) - let argsR, tpenv = TcExprsWithFlexes cenv env m tpenv flexes argTys args + let argsR, tpenv = TcExprsNoFlexes cenv env m tpenv argTys args let expr = mkAnyTupled g m tupInfo argsR argTys expr, tpenv ) @@ -6092,8 +6094,7 @@ and TcExprILAssembly (cenv: cenv) overallTy env tpenv (ilInstrs, synTyArgs, synA let argTys = NewInferenceTypes g synArgs let tyargs, tpenv = TcTypes cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synTyArgs // No subsumption at uses of IL assembly code - let flexes = argTys |> List.map (fun _ -> false) - let args, tpenv = TcExprsWithFlexes cenv env m tpenv flexes argTys synArgs + let args, tpenv = TcExprsNoFlexes cenv env m tpenv argTys synArgs let retTys, tpenv = TcTypes cenv NewTyparsOK CheckCxs ItemOccurence.UseInType WarnOnIWSAM.Yes env tpenv synRetTys let returnTy = match retTys with @@ -7157,8 +7158,7 @@ and TcInterpolatedStringExpr cenv (overallTy: OverallTy) env m tpenv (parts: Syn mkCallNewFormat g m printerTy printerArgTy printerResidueTy printerResultTy printerTupleTy str, tpenv else // Type check the expressions filling the holes - let flexes = argTys |> List.map (fun _ -> false) - let fillExprs, tpenv = TcExprsWithFlexes cenv env m tpenv flexes argTys synFillExprs + let fillExprs, tpenv = TcExprsNoFlexes cenv env m tpenv argTys synFillExprs let fillExprsBoxed = (argTys, fillExprs) ||> List.map2 (mkCallBox g m) @@ -7184,8 +7184,7 @@ and TcInterpolatedStringExpr cenv (overallTy: OverallTy) env m tpenv (parts: Syn | Choice2Of2 createFormattableStringMethod -> // Type check the expressions filling the holes - let flexes = argTys |> List.map (fun _ -> false) - let fillExprs, tpenv = TcExprsWithFlexes cenv env m tpenv flexes argTys synFillExprs + let fillExprs, tpenv = TcExprsNoFlexes cenv env m tpenv argTys synFillExprs let fillExprsBoxed = (argTys, fillExprs) ||> List.map2 (mkCallBox g m) diff --git a/src/Compiler/Checking/CheckExpressions.fsi b/src/Compiler/Checking/CheckExpressions.fsi index 0bbaca89177..6c86f8b4525 100644 --- a/src/Compiler/Checking/CheckExpressions.fsi +++ b/src/Compiler/Checking/CheckExpressions.fsi @@ -623,6 +623,18 @@ val TcExpr: synExpr: SynExpr -> Expr * UnscopedTyparEnv +/// Check that 'args' have the correct number of elements for a tuple expression. +/// If not, use 'typeCheckArgs' to type check the given elements to show +/// their correct types (if known) in the error message and raise the error +val CheckTupleIsCorrectLength: + g: TcGlobals -> + env: TcEnv -> + m: range -> + tupleTy: TType -> + args: 'a list -> + typeCheckArgs: (TType list -> unit) -> + unit + /// Converts 'a..b' to a call to the '(..)' operator in FSharp.Core /// Converts 'a..b..c' to a call to the '(.. ..)' operator in FSharp.Core val RewriteRangeExpr: synExpr: SynExpr -> SynExpr option diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs index dccff65781b..7ddf4b4a0a0 100644 --- a/src/Compiler/Checking/CheckPatterns.fs +++ b/src/Compiler/Checking/CheckPatterns.fs @@ -418,6 +418,8 @@ and TcPatAnds warnOnUpper cenv env vFlags patEnv ty pats m = and TcPatTuple warnOnUpper cenv env vFlags patEnv ty isExplicitStruct args m = let g = cenv.g try + CheckTupleIsCorrectLength g env m ty args (fun argTys -> TcPatterns warnOnUpper cenv env vFlags patEnv argTys args |> ignore) + let tupInfo, argTys = UnifyTupleTypeAndInferCharacteristics env.eContextInfo cenv env.DisplayEnv m ty isExplicitStruct args let argsR, acc = TcPatterns warnOnUpper cenv env vFlags patEnv argTys args let phase2 values = TPat_tuple(tupInfo, List.map (fun f -> f values) argsR, argTys, m) diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs index 8025a7f7746..cf7b994b20f 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs @@ -52,6 +52,43 @@ let x: int * int = "", "", 1 "Type mismatch. Expecting a tuple of length 2 of type\n int * int \nbut given a tuple of length 3 of type\n string * string * int \n") ] + [] + let ``Patterns minimal`` () = + FSharp """ +let test (x : int * string * char) = + match x with + | 10, "20" -> true + | _ -> false + """ + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 1, Line 4, Col 7, Line 4, Col 15, + "Type mismatch. Expecting a tuple of length 3 of type\n int * string * char \nbut given a tuple of length 2 of type\n int * string \n") + ] + + [] + let ``Patterns with inference`` () = + FSharp """ +let test x = + match x with + | 0, "1", '2' -> true + | 10, "20" -> true + | "-1", '0' -> true + | 99, '9' -> true + | _ -> false + """ + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 1, Line 5, Col 7, Line 5, Col 15, + "Type mismatch. Expecting a tuple of length 3 of type\n int * string * char \nbut given a tuple of length 2 of type\n int * string \n") + (Error 1, Line 6, Col 11, Line 6, Col 20, + "Type mismatch. Expecting a tuple of length 3 of type\n int * string * char \nbut given a tuple of length 2 of type\n string * char \n") + (Error 1, Line 7, Col 7, Line 7, Col 20, + "Type mismatch. Expecting a tuple of length 3 of type\n int * string * char \nbut given a tuple of length 2 of type\n int * char \n") + ] + [] let ``return Instead Of return!``() = FSharp """ diff --git a/tests/fsharpqa/Source/Conformance/PatternMatching/Tuple/E_TupleMismatch01.fs b/tests/fsharpqa/Source/Conformance/PatternMatching/Tuple/E_TupleMismatch01.fs deleted file mode 100644 index b8df6f86f79..00000000000 --- a/tests/fsharpqa/Source/Conformance/PatternMatching/Tuple/E_TupleMismatch01.fs +++ /dev/null @@ -1,15 +0,0 @@ -// #Regression #Conformance #PatternMatching #Tuples -// Verify error if tuple sizes mismatch - -//Type mismatch\. Expecting a. 'int \* string \* char' .but given a. 'int \* string' .The tuples have differing lengths of 3 and 2 - -let test (x : int * string * char) = - match x with - | 0, "1", '2' -> true - | 10, "20" -> true - | "-1", '0' -> true - | 99, '9' -> true - | _ -> false - -exit 1 - diff --git a/tests/fsharpqa/Source/Conformance/PatternMatching/Tuple/env.lst b/tests/fsharpqa/Source/Conformance/PatternMatching/Tuple/env.lst index 1aa69ff867a..93d1e5338a4 100644 --- a/tests/fsharpqa/Source/Conformance/PatternMatching/Tuple/env.lst +++ b/tests/fsharpqa/Source/Conformance/PatternMatching/Tuple/env.lst @@ -2,6 +2,4 @@ SOURCE=SimpleTuples01.fs # SimpleTuples01.fs SOURCE=W_IncompleteMatches01.fs # W_IncompleteMatches01.fs SOURCE=W_RedundantPattern01.fs # W_RedundantPattern01.fs - SOURCE=W_RedundantPattern02.fs # W_RedundantPattern02.fs - - SOURCE=E_TupleMismatch01.fs SCFLAGS="--test:ErrorRanges --flaterrors" # E_TupleMismatch01.fs + SOURCE=W_RedundantPattern02.fs # W_RedundantPattern02.fss From 2a2eb0ad223288a0521333ea59652c455f3b02ed Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Tue, 27 Sep 2022 14:00:27 +0200 Subject: [PATCH 12/18] typo --- tests/fsharpqa/Source/Conformance/PatternMatching/Tuple/env.lst | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/fsharpqa/Source/Conformance/PatternMatching/Tuple/env.lst b/tests/fsharpqa/Source/Conformance/PatternMatching/Tuple/env.lst index 93d1e5338a4..25f330533ba 100644 --- a/tests/fsharpqa/Source/Conformance/PatternMatching/Tuple/env.lst +++ b/tests/fsharpqa/Source/Conformance/PatternMatching/Tuple/env.lst @@ -2,4 +2,4 @@ SOURCE=SimpleTuples01.fs # SimpleTuples01.fs SOURCE=W_IncompleteMatches01.fs # W_IncompleteMatches01.fs SOURCE=W_RedundantPattern01.fs # W_RedundantPattern01.fs - SOURCE=W_RedundantPattern02.fs # W_RedundantPattern02.fss + SOURCE=W_RedundantPattern02.fs # W_RedundantPattern02.fs From c92271731074d6268dc64b428c867640f6d32312 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Tue, 27 Sep 2022 14:52:02 +0200 Subject: [PATCH 13/18] Update test baseline --- tests/fsharp/typecheck/sigs/neg04.bsl | 32 +++++++++++++-------------- 1 file changed, 16 insertions(+), 16 deletions(-) diff --git a/tests/fsharp/typecheck/sigs/neg04.bsl b/tests/fsharp/typecheck/sigs/neg04.bsl index f71119b8722..25a4a425582 100644 --- a/tests/fsharp/typecheck/sigs/neg04.bsl +++ b/tests/fsharp/typecheck/sigs/neg04.bsl @@ -14,31 +14,31 @@ neg04.fs(26,8,26,17): typecheck error FS0912: This declaration element is not pe neg04.fs(32,8,32,11): typecheck error FS0039: The type 'Double' does not define the field, constructor or member 'Nan'. Maybe you want one of the following: IsNaN -neg04.fs(46,69,46,94): typecheck error FS0001: Type mismatch. Expecting a - ''a * 'b * 'c * 'e' -but given a - ''a * 'b * 'c' -The tuples have differing lengths of 4 and 3 +neg04.fs(46,69,46,94): typecheck error FS0001: Type mismatch. Expecting a tuple of length 4 of type + 'a * 'g * 'f * 'i +but given a tuple of length 3 of type + 'c * 'l * 'm + + +neg04.fs(46,99,46,107): typecheck error FS0001: Type mismatch. Expecting a tuple of length 4 of type + 'a * 'g * 'f * 'i +but given a tuple of length 3 of type + 'n * 'o * 'p -neg04.fs(46,99,46,107): typecheck error FS0001: Type mismatch. Expecting a - ''a * 'b * 'c * 'e' -but given a - ''a * 'b * 'c' -The tuples have differing lengths of 4 and 3 neg04.fs(47,30,47,51): typecheck error FS0001: Type mismatch. Expecting a - 'seq<'a> -> 'f' + 'seq<'a> -> 'n' but given a - ''g list -> 'h' -The type 'seq<'a>' does not match the type ''f list' + ''o list -> 'p' +The type 'seq<'a>' does not match the type ''n list' neg04.fs(47,49,47,51): typecheck error FS0784: This numeric literal requires that a module 'NumericLiteralN' defining functions FromZero, FromOne, FromInt32, FromInt64 and FromString be in scope neg04.fs(47,30,47,51): typecheck error FS0001: Type mismatch. Expecting a - 'seq<'a> -> 'f' + 'seq<'a> -> 'n' but given a - ''g list -> 'h' -The type 'seq<'a>' does not match the type ''f list' + ''o list -> 'p' +The type 'seq<'a>' does not match the type ''n list' neg04.fs(61,25,61,40): typecheck error FS0001: This expression was expected to have type 'ClassType1' From 790280a62fdc2092ac7cad636f1ba73bb54dd4cc Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Tue, 27 Sep 2022 15:09:19 +0200 Subject: [PATCH 14/18] Type annotation test --- .../ErrorMessages/TypeMismatchTests.fs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs index cf7b994b20f..9447c8821f8 100644 --- a/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/ErrorMessages/TypeMismatchTests.fs @@ -21,6 +21,21 @@ let x a b c : int * int = a, b, c "Type mismatch. Expecting a tuple of length 2 of type\n int * int \nbut given a tuple of length 3 of type\n 'a * 'b * 'c \n") ] + [] + let ``Type annotation propagates to the error message``() = + FSharp """ +let x a b (c: string) : int * int = a, b, c +let y a (b: string) c : int * int = a, b, c + """ + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 1, Line 2, Col 37, Line 2, Col 44, + "Type mismatch. Expecting a tuple of length 2 of type\n int * int \nbut given a tuple of length 3 of type\n 'a * 'b * string \n") + (Error 1, Line 3, Col 37, Line 3, Col 44, + "Type mismatch. Expecting a tuple of length 2 of type\n int * int \nbut given a tuple of length 3 of type\n 'a * string * 'b \n") + ] + [] let ``Known type on the right``() = FSharp """ From d9d840ed26831173b3e6eb21713db5af49d65a71 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Tue, 11 Oct 2022 10:35:24 +0200 Subject: [PATCH 15/18] fantomas after merge --- src/Compiler/Driver/CompilerDiagnostics.fs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index d90f3f0d969..b518ea9338d 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -740,6 +740,7 @@ type Exception with | ErrorFromAddingTypeEquation (_g, denv, ty1, ty2, ConstraintSolverTupleDiffLengths (_, tl1, tl2, _, _), _) -> let ty1, ty2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 + if ty1 <> ty2 + tpcs then os.AppendString(ErrorFromAddingTypeEquationTuplesE().Format tl1.Length ty1 tl2.Length ty2 tpcs) From cc56c30a1c5c0564cba8a92ed5dedba2bb479a42 Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Mon, 17 Oct 2022 13:30:42 +0200 Subject: [PATCH 16/18] Applied review suggestions --- src/Compiler/Checking/CheckExpressions.fs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 0c5c478be42..f3b1e9ca645 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -5288,13 +5288,13 @@ and TcExprThenDynamic (cenv: cenv) overallTy env tpenv isArg e1 mQmark e2 delaye TcExprThen cenv overallTy env tpenv isArg appExpr delayed -and TcExprsWithFlexes (cenv: cenv) env m tpenv flexes argTys args = - if List.length args <> List.length argTys then error(Error(FSComp.SR.tcExpressionCountMisMatch((List.length argTys), (List.length args)), m)) +and TcExprsWithFlexes (cenv: cenv) env m tpenv flexes (argTys: TType list) (args: SynExpr list) = + if args.Length <> argTys.Length then error(Error(FSComp.SR.tcExpressionCountMisMatch((argTys.Length), (args.Length)), m)) (tpenv, List.zip3 flexes argTys args) ||> List.mapFold (fun tpenv (flex, ty, e) -> TcExprFlex cenv flex false ty env tpenv e) -and TcExprsNoFlexes (cenv: cenv) env m tpenv argTys args = - if List.length args <> List.length argTys then error(Error(FSComp.SR.tcExpressionCountMisMatch((List.length argTys), (List.length args)), m)) +and TcExprsNoFlexes (cenv: cenv) env m tpenv (argTys: TType list) (args: SynExpr list) = + if args.Length <> argTys.Length then error(Error(FSComp.SR.tcExpressionCountMisMatch((argTys.Length), (args.Length)), m)) (tpenv, List.zip argTys args) ||> List.mapFold (fun tpenv (ty, e) -> TcExprFlex2 cenv ty env false tpenv e) @@ -5804,13 +5804,13 @@ and TcExprLazy (cenv: cenv) overallTy env tpenv (synInnerExpr, m) = let expr = mkLazyDelayed g m innerTy (mkUnitDelayLambda g m innerExpr) expr, tpenv -and CheckTupleIsCorrectLength g (env: TcEnv) m tupleTy args typeCheckArgs = +and CheckTupleIsCorrectLength g (env: TcEnv) m tupleTy (args: 'a list) tcArgs = if isAnyTupleTy g tupleTy then let tupInfo, ptys = destAnyTupleTy g tupleTy - if List.length args <> List.length ptys then + if args.Length <> ptys.Length then let argTys = NewInferenceTypes g args - suppressErrorReporting (fun () -> typeCheckArgs argTys) + suppressErrorReporting (fun () -> tcArgs argTys) let expectedTy = TType_tuple (tupInfo, argTys) // We let error recovery handle this exception From 2c7656beefd59d8b73326ed9c119cfb845bc831a Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Mon, 17 Oct 2022 13:48:44 +0200 Subject: [PATCH 17/18] Fix signature file --- src/Compiler/Checking/CheckExpressions.fsi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fsi b/src/Compiler/Checking/CheckExpressions.fsi index 6c86f8b4525..11f0ff1ccb0 100644 --- a/src/Compiler/Checking/CheckExpressions.fsi +++ b/src/Compiler/Checking/CheckExpressions.fsi @@ -624,7 +624,7 @@ val TcExpr: Expr * UnscopedTyparEnv /// Check that 'args' have the correct number of elements for a tuple expression. -/// If not, use 'typeCheckArgs' to type check the given elements to show +/// If not, use 'tcArgs' to type check the given elements to show /// their correct types (if known) in the error message and raise the error val CheckTupleIsCorrectLength: g: TcGlobals -> @@ -632,7 +632,7 @@ val CheckTupleIsCorrectLength: m: range -> tupleTy: TType -> args: 'a list -> - typeCheckArgs: (TType list -> unit) -> + tcArgs: (TType list -> unit) -> unit /// Converts 'a..b' to a call to the '(..)' operator in FSharp.Core From 70cbd8bc5148ccf4592e78939a60c25ccc3dbefa Mon Sep 17 00:00:00 2001 From: Petr Pokorny Date: Mon, 17 Oct 2022 13:53:40 +0200 Subject: [PATCH 18/18] fantomas --- src/Compiler/Checking/CheckExpressions.fsi | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/src/Compiler/Checking/CheckExpressions.fsi b/src/Compiler/Checking/CheckExpressions.fsi index 11f0ff1ccb0..5c2b0b6451f 100644 --- a/src/Compiler/Checking/CheckExpressions.fsi +++ b/src/Compiler/Checking/CheckExpressions.fsi @@ -627,13 +627,7 @@ val TcExpr: /// If not, use 'tcArgs' to type check the given elements to show /// their correct types (if known) in the error message and raise the error val CheckTupleIsCorrectLength: - g: TcGlobals -> - env: TcEnv -> - m: range -> - tupleTy: TType -> - args: 'a list -> - tcArgs: (TType list -> unit) -> - unit + g: TcGlobals -> env: TcEnv -> m: range -> tupleTy: TType -> args: 'a list -> tcArgs: (TType list -> unit) -> unit /// Converts 'a..b' to a call to the '(..)' operator in FSharp.Core /// Converts 'a..b..c' to a call to the '(.. ..)' operator in FSharp.Core