From 4c9a74e6c3d1fa57f5b0b17f8564536830d21a30 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Tue, 15 Aug 2023 21:57:39 +0200 Subject: [PATCH 1/7] Use trackErrors ce instead of ++ custom operator --- src/Compiler/Checking/AttributeChecking.fs | 59 +++++++++++----------- src/Compiler/Checking/ConstraintSolver.fs | 15 +++--- 2 files changed, 37 insertions(+), 37 deletions(-) diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index 087ebc1e0b1..1a4138e0498 100644 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -266,29 +266,28 @@ let langVersionPrefix = "--langversion:preview" /// Check F# attributes for 'ObsoleteAttribute', 'CompilerMessageAttribute' and 'ExperimentalAttribute', /// returning errors and warnings as data -let CheckFSharpAttributes (g:TcGlobals) attribs m = +let CheckFSharpAttributes (g:TcGlobals) attribs m = trackErrors { let isExperimentalAttributeDisabled (s:string) = if g.compilingFSharpCore then true else g.langVersion.IsPreviewEnabled && (s.IndexOf(langVersionPrefix, StringComparison.OrdinalIgnoreCase) >= 0) - if isNil attribs then CompleteD + if isNil attribs then do! CompleteD else - (match TryFindFSharpAttribute g g.attrib_SystemObsolete attribs with + match TryFindFSharpAttribute g g.attrib_SystemObsolete attribs with | Some(Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> - WarnD(ObsoleteWarning(s, m)) + do! WarnD(ObsoleteWarning(s, m)) | Some(Attrib(_, _, [ AttribStringArg s; AttribBoolArg(isError) ], _, _, _, _)) -> if isError then - ErrorD (ObsoleteError(s, m)) + do! ErrorD (ObsoleteError(s, m)) else - WarnD (ObsoleteWarning(s, m)) + do! WarnD (ObsoleteWarning(s, m)) | Some _ -> - WarnD(ObsoleteWarning("", m)) + do! WarnD(ObsoleteWarning("", m)) | None -> - CompleteD - ) ++ (fun () -> - + do! CompleteD + match TryFindFSharpAttribute g g.attrib_CompilerMessageAttribute attribs with | Some(Attrib(_, _, [ AttribStringArg s ; AttribInt32Arg n ], namedArgs, _, _, _)) -> let msg = UserCompilerMessage(s, n, m) @@ -298,31 +297,29 @@ let CheckFSharpAttributes (g:TcGlobals) attribs m = | _ -> false // If we are using a compiler that supports nameof then error 3501 is always suppressed. // See attribute on FSharp.Core 'nameof' - if n = 3501 then CompleteD - elif isError && (not g.compilingFSharpCore || n <> 1204) then ErrorD msg - else WarnD msg + if n = 3501 then do! CompleteD + elif isError && (not g.compilingFSharpCore || n <> 1204) then do! ErrorD msg + else do! WarnD msg | _ -> - CompleteD - ) ++ (fun () -> + do! CompleteD match TryFindFSharpAttribute g g.attrib_ExperimentalAttribute attribs with | Some(Attrib(_, _, [ AttribStringArg(s) ], _, _, _, _)) -> if isExperimentalAttributeDisabled s then - CompleteD + do! CompleteD else - WarnD(Experimental(s, m)) + do! WarnD(Experimental(s, m)) | Some _ -> - WarnD(Experimental(FSComp.SR.experimentalConstruct (), m)) + do! WarnD(Experimental(FSComp.SR.experimentalConstruct (), m)) | _ -> - CompleteD - ) ++ (fun () -> + do! CompleteD match TryFindFSharpAttribute g g.attrib_UnverifiableAttribute attribs with | Some _ -> - WarnD(PossibleUnverifiableCode(m)) + do! WarnD(PossibleUnverifiableCode(m)) | _ -> - CompleteD - ) + do! CompleteD +} #if !NO_TYPEPROVIDERS /// Check a list of provided attributes for 'ObsoleteAttribute', returning errors and warnings as data @@ -503,15 +500,17 @@ let PropInfoIsUnseen m pinfo = #endif /// Check the attributes on a union case, returning errors and warnings as data. -let CheckUnionCaseAttributes g (x:UnionCaseRef) m = - CheckEntityAttributes g x.TyconRef m ++ (fun () -> - CheckFSharpAttributes g x.Attribs m) +let CheckUnionCaseAttributes g (x:UnionCaseRef) m = trackErrors { + do! CheckEntityAttributes g x.TyconRef m + do! CheckFSharpAttributes g x.Attribs m +} /// Check the attributes on a record field, returning errors and warnings as data. -let CheckRecdFieldAttributes g (x:RecdFieldRef) m = - CheckEntityAttributes g x.TyconRef m ++ (fun () -> - CheckFSharpAttributes g x.PropertyAttribs m) ++ (fun () -> - CheckFSharpAttributes g x.RecdField.FieldAttribs m) +let CheckRecdFieldAttributes g (x:RecdFieldRef) m = trackErrors { + do! CheckEntityAttributes g x.TyconRef m + do! CheckFSharpAttributes g x.PropertyAttribs m + do! CheckFSharpAttributes g x.RecdField.FieldAttribs m +} /// Check the attributes on an F# value, returning errors and warnings as data. let CheckValAttributes g (x:ValRef) m = diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index e999152ce54..8f01b57204f 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -1187,10 +1187,10 @@ and SolveTypeEqualsType (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr if evalTupInfoIsStruct tupInfo1 <> evalTupInfoIsStruct tupInfo2 then ErrorD (ConstraintSolverError(FSComp.SR.tcTupleStructMismatch(), csenv.m, m2)) else SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2 - | TType_anon (anonInfo1, l1),TType_anon (anonInfo2, l2) -> - SolveAnonInfoEqualsAnonInfo csenv m2 anonInfo1 anonInfo2 ++ (fun () -> - SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2) - + | TType_anon (anonInfo1, l1),TType_anon (anonInfo2, l2) -> trackErrors { + do! SolveAnonInfoEqualsAnonInfo csenv m2 anonInfo1 anonInfo2 + do! SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2 + } | TType_fun (domainTy1, rangeTy1, _), TType_fun (domainTy2, rangeTy2, _) -> SolveFunTypeEqn csenv ndeep m2 trace None domainTy1 domainTy2 rangeTy1 rangeTy2 @@ -1274,9 +1274,10 @@ and SolveTypeSubsumesType (csenv: ConstraintSolverEnv) ndeep m2 (trace: Optional if evalTupInfoIsStruct tupInfo1 <> evalTupInfoIsStruct tupInfo2 then ErrorD (ConstraintSolverError(FSComp.SR.tcTupleStructMismatch(), csenv.m, m2)) else SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln l1 l2 (* nb. can unify since no variance *) - | TType_anon (anonInfo1, l1), TType_anon (anonInfo2, l2) -> - SolveAnonInfoEqualsAnonInfo csenv m2 anonInfo1 anonInfo2 ++ (fun () -> - SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln l1 l2) (* nb. can unify since no variance *) + | TType_anon (anonInfo1, l1), TType_anon (anonInfo2, l2) -> trackErrors { + do! SolveAnonInfoEqualsAnonInfo csenv m2 anonInfo1 anonInfo2 + do! SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln l1 l2 (* nb. can unify since no variance *) + } | TType_fun (domainTy1, rangeTy1, _), TType_fun (domainTy2, rangeTy2, _) -> SolveFunTypeEqn csenv ndeep m2 trace cxsln domainTy1 domainTy2 rangeTy1 rangeTy2 (* nb. can unify since no variance *) From cf99eb6dbd58323255729294b46ba9a863b96f51 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Tue, 15 Aug 2023 22:41:10 +0200 Subject: [PATCH 2/7] Move cE be moved to the else branch --- src/Compiler/Checking/AttributeChecking.fs | 102 ++++++++++----------- 1 file changed, 51 insertions(+), 51 deletions(-) diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index 1a4138e0498..5bb782c0b64 100644 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -266,60 +266,60 @@ let langVersionPrefix = "--langversion:preview" /// Check F# attributes for 'ObsoleteAttribute', 'CompilerMessageAttribute' and 'ExperimentalAttribute', /// returning errors and warnings as data -let CheckFSharpAttributes (g:TcGlobals) attribs m = trackErrors { - let isExperimentalAttributeDisabled (s:string) = - if g.compilingFSharpCore then - true - else - g.langVersion.IsPreviewEnabled && (s.IndexOf(langVersionPrefix, StringComparison.OrdinalIgnoreCase) >= 0) - - if isNil attribs then do! CompleteD +let CheckFSharpAttributes (g:TcGlobals) attribs m = + if isNil attribs then CompleteD else - match TryFindFSharpAttribute g g.attrib_SystemObsolete attribs with - | Some(Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> - do! WarnD(ObsoleteWarning(s, m)) - | Some(Attrib(_, _, [ AttribStringArg s; AttribBoolArg(isError) ], _, _, _, _)) -> - if isError then - do! ErrorD (ObsoleteError(s, m)) - else - do! WarnD (ObsoleteWarning(s, m)) - | Some _ -> - do! WarnD(ObsoleteWarning("", m)) - | None -> - do! CompleteD - - match TryFindFSharpAttribute g g.attrib_CompilerMessageAttribute attribs with - | Some(Attrib(_, _, [ AttribStringArg s ; AttribInt32Arg n ], namedArgs, _, _, _)) -> - let msg = UserCompilerMessage(s, n, m) - let isError = - match namedArgs with - | ExtractAttribNamedArg "IsError" (AttribBoolArg v) -> v - | _ -> false - // If we are using a compiler that supports nameof then error 3501 is always suppressed. - // See attribute on FSharp.Core 'nameof' - if n = 3501 then do! CompleteD - elif isError && (not g.compilingFSharpCore || n <> 1204) then do! ErrorD msg - else do! WarnD msg - | _ -> - do! CompleteD + trackErrors { + match TryFindFSharpAttribute g g.attrib_SystemObsolete attribs with + | Some(Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> + do! WarnD(ObsoleteWarning(s, m)) + | Some(Attrib(_, _, [ AttribStringArg s; AttribBoolArg(isError) ], _, _, _, _)) -> + if isError then + do! ErrorD (ObsoleteError(s, m)) + else + do! WarnD (ObsoleteWarning(s, m)) + | Some _ -> + do! WarnD(ObsoleteWarning("", m)) + | None -> + do! CompleteD + + match TryFindFSharpAttribute g g.attrib_CompilerMessageAttribute attribs with + | Some(Attrib(_, _, [ AttribStringArg s ; AttribInt32Arg n ], namedArgs, _, _, _)) -> + let msg = UserCompilerMessage(s, n, m) + let isError = + match namedArgs with + | ExtractAttribNamedArg "IsError" (AttribBoolArg v) -> v + | _ -> false + // If we are using a compiler that supports nameof then error 3501 is always suppressed. + // See attribute on FSharp.Core 'nameof' + if n = 3501 then do! CompleteD + elif isError && (not g.compilingFSharpCore || n <> 1204) then do! ErrorD msg + else do! WarnD msg + | _ -> + do! CompleteD - match TryFindFSharpAttribute g g.attrib_ExperimentalAttribute attribs with - | Some(Attrib(_, _, [ AttribStringArg(s) ], _, _, _, _)) -> - if isExperimentalAttributeDisabled s then + match TryFindFSharpAttribute g g.attrib_ExperimentalAttribute attribs with + | Some(Attrib(_, _, [ AttribStringArg(s) ], _, _, _, _)) -> + let isExperimentalAttributeDisabled (s:string) = + if g.compilingFSharpCore then + true + else + g.langVersion.IsPreviewEnabled && (s.IndexOf(langVersionPrefix, StringComparison.OrdinalIgnoreCase) >= 0) + if isExperimentalAttributeDisabled s then + do! CompleteD + else + do! WarnD(Experimental(s, m)) + | Some _ -> + do! WarnD(Experimental(FSComp.SR.experimentalConstruct (), m)) + | _ -> do! CompleteD - else - do! WarnD(Experimental(s, m)) - | Some _ -> - do! WarnD(Experimental(FSComp.SR.experimentalConstruct (), m)) - | _ -> - do! CompleteD - - match TryFindFSharpAttribute g g.attrib_UnverifiableAttribute attribs with - | Some _ -> - do! WarnD(PossibleUnverifiableCode(m)) - | _ -> - do! CompleteD -} + + match TryFindFSharpAttribute g g.attrib_UnverifiableAttribute attribs with + | Some _ -> + do! WarnD(PossibleUnverifiableCode(m)) + | _ -> + do! CompleteD + } #if !NO_TYPEPROVIDERS /// Check a list of provided attributes for 'ObsoleteAttribute', returning errors and warnings as data From cb9e6e53bb617552b4979650f4883d1fb4ae393b Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Tue, 15 Aug 2023 23:02:14 +0200 Subject: [PATCH 3/7] one more --- src/Compiler/Checking/AttributeChecking.fs | 31 ++++++++++++---------- 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index 5bb782c0b64..13cb1722f12 100644 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -414,21 +414,24 @@ let CheckILEventAttributes g (tcref: TyconRef) cattrs m = CheckILAttributes g (isByrefLikeTyconRef g m tcref) cattrs m /// Check the attributes associated with a method, returning warnings and errors as data. -let CheckMethInfoAttributes g m tyargsOpt (minfo: MethInfo) = - match stripTyEqns g minfo.ApparentEnclosingAppType with - | TType_app(tcref, _, _) -> CheckEntityAttributes g tcref m - | _ -> CompleteD - ++ (fun () -> +let CheckMethInfoAttributes g m tyargsOpt (minfo: MethInfo) = + trackErrors { + match stripTyEqns g minfo.ApparentEnclosingAppType with + | TType_app(tcref, _, _) -> do! CheckEntityAttributes g tcref m + | _ -> do! CompleteD let search = BindMethInfoAttributes m minfo (fun ilAttribs -> Some(CheckILAttributes g false ilAttribs m)) (fun fsAttribs -> - let res = - CheckFSharpAttributes g fsAttribs m ++ (fun () -> - if Option.isNone tyargsOpt && HasFSharpAttribute g g.attrib_RequiresExplicitTypeArgumentsAttribute fsAttribs then - ErrorD(Error(FSComp.SR.tcFunctionRequiresExplicitTypeArguments(minfo.LogicalName), m)) - else - CompleteD) + let res = + trackErrors { + do! CheckFSharpAttributes g fsAttribs m + if Option.isNone tyargsOpt && HasFSharpAttribute g g.attrib_RequiresExplicitTypeArgumentsAttribute fsAttribs then + do! ErrorD(Error(FSComp.SR.tcFunctionRequiresExplicitTypeArguments(minfo.LogicalName), m)) + else + do! CompleteD + } + Some res) #if !NO_TYPEPROVIDERS (fun provAttribs -> Some (CheckProvidedAttributes g m provAttribs)) @@ -436,9 +439,9 @@ let CheckMethInfoAttributes g m tyargsOpt (minfo: MethInfo) = (fun _provAttribs -> None) #endif match search with - | Some res -> res - | None -> CompleteD // no attribute = no errors - ) + | Some res -> do! res + | None -> do! CompleteD // no attribute = no errors +} /// Indicate if a method has 'Obsolete', 'CompilerMessageAttribute' or 'TypeProviderEditorHideMethodsAttribute'. /// Used to suppress the item in intellisense. From 75e63f7caffaeb8af7fa58a201848ab4369af9c1 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Tue, 15 Aug 2023 23:12:05 +0200 Subject: [PATCH 4/7] another one --- src/Compiler/Checking/ConstraintSolver.fs | 135 +++++++++++----------- 1 file changed, 70 insertions(+), 65 deletions(-) diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 8f01b57204f..df3c49a8c9e 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -1059,73 +1059,78 @@ and SolveTyparsEqualTypes (csenv: ConstraintSolverEnv) ndeep m2 (trace: Optional } and SolveAnonInfoEqualsAnonInfo (csenv: ConstraintSolverEnv) m2 (anonInfo1: AnonRecdTypeInfo) (anonInfo2: AnonRecdTypeInfo) = - if evalTupInfoIsStruct anonInfo1.TupInfo <> evalTupInfoIsStruct anonInfo2.TupInfo then ErrorD (ConstraintSolverError(FSComp.SR.tcTupleStructMismatch(), csenv.m,m2)) else - (match anonInfo1.Assembly, anonInfo2.Assembly with - | ccu1, ccu2 -> if not (ccuEq ccu1 ccu2) then ErrorD (ConstraintSolverError(FSComp.SR.tcAnonRecdCcuMismatch(ccu1.AssemblyName, ccu2.AssemblyName), csenv.m,m2)) else ResultD () - ) ++ (fun () -> - - if not (anonInfo1.SortedNames = anonInfo2.SortedNames) then - let (|Subset|Superset|Overlap|CompletelyDifferent|) (first, second) = - let first = Set first - let second = Set second - let secondOnly = Set.toList (second - first) - let firstOnly = Set.toList (first - second) - - if second.IsSubsetOf first then - Subset firstOnly - elif second.IsSupersetOf first then - Superset secondOnly - elif Set.intersect first second <> Set.empty then - Overlap(firstOnly, secondOnly) + if evalTupInfoIsStruct anonInfo1.TupInfo <> evalTupInfoIsStruct anonInfo2.TupInfo then + ErrorD (ConstraintSolverError(FSComp.SR.tcTupleStructMismatch(), csenv.m,m2)) + else + trackErrors { + if not (ccuEq anonInfo1.Assembly anonInfo2.Assembly) then + do! ErrorD (ConstraintSolverError(FSComp.SR.tcAnonRecdCcuMismatch(anonInfo1.Assembly.AssemblyName, anonInfo2.Assembly.AssemblyName), csenv.m,m2)) else - let first = Set.toList first - let second = Set.toList second - CompletelyDifferent(first, second) - - let message = - match anonInfo1.SortedNames, anonInfo2.SortedNames with - | Subset missingFields -> - match missingFields with - | [missingField] -> - FSComp.SR.tcAnonRecdSingleFieldNameSubset(string missingField) - | _ -> - let missingFields = missingFields |> List.map(sprintf "'%s'") - let missingFields = String.concat ", " missingFields - FSComp.SR.tcAnonRecdMultipleFieldsNameSubset(string missingFields) - | Superset extraFields -> - match extraFields with - | [extraField] -> - FSComp.SR.tcAnonRecdSingleFieldNameSuperset(string extraField) - | _ -> - let extraFields = extraFields |> List.map(sprintf "'%s'") - let extraFields = String.concat ", " extraFields - FSComp.SR.tcAnonRecdMultipleFieldsNameSuperset(string extraFields) - | Overlap (missingFields, extraFields) -> - FSComp.SR.tcAnonRecdFieldNameMismatch(string missingFields, string extraFields) - | CompletelyDifferent missingFields -> - let missingFields, usedFields = missingFields - match missingFields, usedFields with - | [ missingField ], [ usedField ] -> - FSComp.SR.tcAnonRecdSingleFieldNameSingleDifferent(missingField, usedField) - | [ missingField ], usedFields -> - let usedFields = usedFields |> List.map(sprintf "'%s'") - let usedFields = String.concat ", " usedFields - FSComp.SR.tcAnonRecdSingleFieldNameMultipleDifferent(missingField, usedFields) - | missingFields, [ usedField ] -> - let missingFields = missingFields |> List.map(sprintf "'%s'") - let missingFields = String.concat ", " missingFields - FSComp.SR.tcAnonRecdMultipleFieldNameSingleDifferent(missingFields, usedField) + do! ResultD() - | missingFields, usedFields -> - let missingFields = missingFields |> List.map(sprintf "'%s'") - let missingFields = String.concat ", " missingFields - let usedFields = usedFields |> List.map(sprintf "'%s'") - let usedFields = String.concat ", " usedFields - FSComp.SR.tcAnonRecdMultipleFieldNameMultipleDifferent(missingFields, usedFields) - - ErrorD (ConstraintSolverError(message, csenv.m,m2)) - else - ResultD ()) + if not (anonInfo1.SortedNames = anonInfo2.SortedNames) then + let (|Subset|Superset|Overlap|CompletelyDifferent|) (first, second) = + let first = Set first + let second = Set second + let secondOnly = Set.toList (second - first) + let firstOnly = Set.toList (first - second) + + if second.IsSubsetOf first then + Subset firstOnly + elif second.IsSupersetOf first then + Superset secondOnly + elif Set.intersect first second <> Set.empty then + Overlap(firstOnly, secondOnly) + else + let first = Set.toList first + let second = Set.toList second + CompletelyDifferent(first, second) + + let message = + match anonInfo1.SortedNames, anonInfo2.SortedNames with + | Subset missingFields -> + match missingFields with + | [missingField] -> + FSComp.SR.tcAnonRecdSingleFieldNameSubset(string missingField) + | _ -> + let missingFields = missingFields |> List.map(sprintf "'%s'") + let missingFields = String.concat ", " missingFields + FSComp.SR.tcAnonRecdMultipleFieldsNameSubset(string missingFields) + | Superset extraFields -> + match extraFields with + | [extraField] -> + FSComp.SR.tcAnonRecdSingleFieldNameSuperset(string extraField) + | _ -> + let extraFields = extraFields |> List.map(sprintf "'%s'") + let extraFields = String.concat ", " extraFields + FSComp.SR.tcAnonRecdMultipleFieldsNameSuperset(string extraFields) + | Overlap (missingFields, extraFields) -> + FSComp.SR.tcAnonRecdFieldNameMismatch(string missingFields, string extraFields) + | CompletelyDifferent missingFields -> + let missingFields, usedFields = missingFields + match missingFields, usedFields with + | [ missingField ], [ usedField ] -> + FSComp.SR.tcAnonRecdSingleFieldNameSingleDifferent(missingField, usedField) + | [ missingField ], usedFields -> + let usedFields = usedFields |> List.map(sprintf "'%s'") + let usedFields = String.concat ", " usedFields + FSComp.SR.tcAnonRecdSingleFieldNameMultipleDifferent(missingField, usedFields) + | missingFields, [ usedField ] -> + let missingFields = missingFields |> List.map(sprintf "'%s'") + let missingFields = String.concat ", " missingFields + FSComp.SR.tcAnonRecdMultipleFieldNameSingleDifferent(missingFields, usedField) + + | missingFields, usedFields -> + let missingFields = missingFields |> List.map(sprintf "'%s'") + let missingFields = String.concat ", " missingFields + let usedFields = usedFields |> List.map(sprintf "'%s'") + let usedFields = String.concat ", " usedFields + FSComp.SR.tcAnonRecdMultipleFieldNameMultipleDifferent(missingFields, usedFields) + + do! ErrorD (ConstraintSolverError(message, csenv.m,m2)) + else + do! ResultD() + } /// Add the constraint "ty1 = ty2" to the constraint problem. /// Propagate all effects of adding this constraint, e.g. to solve type variables From 0514e881c2e03b2c004504b8b21432aa4a01c7bc Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Tue, 15 Aug 2023 23:17:24 +0200 Subject: [PATCH 5/7] another one --- src/Compiler/Checking/ConstraintSolver.fs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index df3c49a8c9e..53d4a97bd0a 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -1233,8 +1233,11 @@ and SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln origl1 origl2 = 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) + | h1 :: t1, h2 :: t2 when t1.Length = t2.Length -> + trackErrors { + do! SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln h1 h2 + do! loop t1 t2 + } | _ -> ErrorD(ConstraintSolverTupleDiffLengths(csenv.DisplayEnv, csenv.eContextInfo, origl1, origl2, csenv.m, m2)) loop origl1 origl2 From c487f4908fc1a2598f6fed257309618581a829c0 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Wed, 16 Aug 2023 09:18:17 +0200 Subject: [PATCH 6/7] last one --- src/Compiler/Checking/ConstraintSolver.fs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index 53d4a97bd0a..755961dd0cb 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -3766,7 +3766,11 @@ let IsApplicableMethApprox g amap m (minfo: MethInfo) availObjTy = match minfo.GetObjArgTypes(amap, m, minst) with | [reqdObjTy] -> let reqdObjTy = if isByrefTy g reqdObjTy then destByrefTy g reqdObjTy else reqdObjTy // This is to support byref extension methods. - TryD (fun () -> SolveTypeSubsumesType csenv 0 m NoTrace None reqdObjTy availObjTy ++ (fun () -> ResultD true)) + TryD (fun () -> + trackErrors { + do! SolveTypeSubsumesType csenv 0 m NoTrace None reqdObjTy availObjTy + return true + }) (fun _err -> ResultD false) |> CommitOperationResult | _ -> true From 1fd2e631b03dd1abf686b94cf2c90694a9843a05 Mon Sep 17 00:00:00 2001 From: Edgar Gonzalez Date: Wed, 16 Aug 2023 11:42:16 +0200 Subject: [PATCH 7/7] format code --- src/Compiler/Checking/AttributeChecking.fs | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index 13cb1722f12..9abaac840c3 100644 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -503,17 +503,19 @@ let PropInfoIsUnseen m pinfo = #endif /// Check the attributes on a union case, returning errors and warnings as data. -let CheckUnionCaseAttributes g (x:UnionCaseRef) m = trackErrors { - do! CheckEntityAttributes g x.TyconRef m - do! CheckFSharpAttributes g x.Attribs m -} +let CheckUnionCaseAttributes g (x:UnionCaseRef) m = + trackErrors { + do! CheckEntityAttributes g x.TyconRef m + do! CheckFSharpAttributes g x.Attribs m + } /// Check the attributes on a record field, returning errors and warnings as data. -let CheckRecdFieldAttributes g (x:RecdFieldRef) m = trackErrors { - do! CheckEntityAttributes g x.TyconRef m - do! CheckFSharpAttributes g x.PropertyAttribs m - do! CheckFSharpAttributes g x.RecdField.FieldAttribs m -} +let CheckRecdFieldAttributes g (x:RecdFieldRef) m = + trackErrors { + do! CheckEntityAttributes g x.TyconRef m + do! CheckFSharpAttributes g x.PropertyAttribs m + do! CheckFSharpAttributes g x.RecdField.FieldAttribs m + } /// Check the attributes on an F# value, returning errors and warnings as data. let CheckValAttributes g (x:ValRef) m =