Skip to content

Commit b8c748c

Browse files
dsymedsyme
authored
fix 5580 and better encapsulate constraint solver (#8294)
* fix 5580 and better encapsulate constraint solver * fix 5580 and better encapsulate constraint solver * fix 5580 and better encapsulate constraint solver * fix 5580 and better encapsulate constraint solver * add new tests * nudge CI
1 parent 83f1785 commit b8c748c

13 files changed

+498
-162
lines changed

‎src/fsharp/ConstraintSolver.fs

+181-63
Large diffs are not rendered by default.

‎src/fsharp/ConstraintSolver.fsi

+72-55
Original file line numberDiff line numberDiff line change
@@ -17,32 +17,32 @@ open FSharp.Compiler.MethodCalls
1717
open FSharp.Compiler.InfoReader
1818

1919
/// Create a type variable representing the use of a "_" in F# code
20-
val NewAnonTypar : TyparKind * range * TyparRigidity * TyparStaticReq * TyparDynamicReq -> Typar
20+
val NewAnonTypar: TyparKind * range * TyparRigidity * TyparStaticReq * TyparDynamicReq -> Typar
2121

2222
/// Create an inference type variable
23-
val NewInferenceType : unit -> TType
23+
val NewInferenceType: unit -> TType
2424

2525
/// Create an inference type variable for the kind of a byref pointer
26-
val NewByRefKindInferenceType : TcGlobals -> range -> TType
26+
val NewByRefKindInferenceType: TcGlobals -> range -> TType
2727

2828
/// Create an inference type variable representing an error condition when checking an expression
29-
val NewErrorType : unit -> TType
29+
val NewErrorType: unit -> TType
3030

3131
/// Create an inference type variable representing an error condition when checking a measure
32-
val NewErrorMeasure : unit -> Measure
32+
val NewErrorMeasure: unit -> Measure
3333

3434
/// Create a list of inference type variables, one for each element in the input list
35-
val NewInferenceTypes : 'a list -> TType list
35+
val NewInferenceTypes: 'a list -> TType list
3636

3737
/// Given a set of formal type parameters and their constraints, make new inference type variables for
3838
/// each and ensure that the constraints on the new type variables are adjusted to refer to these.
39-
val FreshenAndFixupTypars : range -> TyparRigidity -> Typars -> TType list -> Typars -> Typars * TyparInst * TType list
39+
val FreshenAndFixupTypars: range -> TyparRigidity -> Typars -> TType list -> Typars -> Typars * TyparInst * TType list
4040

41-
val FreshenTypeInst : range -> Typars -> Typars * TyparInst * TType list
41+
val FreshenTypeInst: range -> Typars -> Typars * TyparInst * TType list
4242

43-
val FreshenTypars : range -> Typars -> TType list
43+
val FreshenTypars: range -> Typars -> TType list
4444

45-
val FreshenMethInfo : range -> MethInfo -> TType list
45+
val FreshenMethInfo: range -> MethInfo -> TType list
4646

4747
[<RequireQualifiedAccess>]
4848
/// Information about the context of a type equation.
@@ -114,53 +114,70 @@ type TcValF = (ValRef -> ValUseFlag -> TType list -> range -> Expr * TType)
114114
type ConstraintSolverState =
115115
static member New: TcGlobals * Import.ImportMap * InfoReader * TcValF -> ConstraintSolverState
116116

117-
type ConstraintSolverEnv
118-
119-
val BakedInTraitConstraintNames : Set<string>
120-
121-
val MakeConstraintSolverEnv : ContextInfo -> ConstraintSolverState -> range -> DisplayEnv -> ConstraintSolverEnv
117+
val BakedInTraitConstraintNames: Set<string>
122118

123119
[<Sealed; NoEquality; NoComparison>]
124120
type Trace
125121

126122
type OptionalTrace =
127-
| NoTrace
128-
| WithTrace of Trace
129-
130-
val SimplifyMeasuresInTypeScheme : TcGlobals -> bool -> Typars -> TType -> TyparConstraint list -> Typars
131-
val SolveTyparEqualsType : ConstraintSolverEnv -> int -> range -> OptionalTrace -> TType -> TType -> OperationResult<unit>
132-
val SolveTypeEqualsTypeKeepAbbrevs : ConstraintSolverEnv -> int -> range -> OptionalTrace -> TType -> TType -> OperationResult<unit>
133-
134-
/// Canonicalize constraints prior to generalization
135-
val CanonicalizeRelevantMemberConstraints : ConstraintSolverEnv -> int -> OptionalTrace -> Typars -> OperationResult<unit>
136-
137-
val ResolveOverloading : ConstraintSolverEnv -> OptionalTrace -> string -> ndeep: int -> TraitConstraintInfo option -> int * int -> AccessorDomain -> CalledMeth<Expr> list -> bool -> TType option -> CalledMeth<Expr> option * OperationResult<unit>
138-
val UnifyUniqueOverloading : ConstraintSolverEnv -> int * int -> string -> AccessorDomain -> CalledMeth<SynExpr> list -> TType -> OperationResult<bool>
139-
val EliminateConstraintsForGeneralizedTypars : ConstraintSolverEnv -> OptionalTrace -> Typars -> unit
140-
141-
val CheckDeclaredTypars : DisplayEnv -> ConstraintSolverState -> range -> Typars -> Typars -> unit
142-
143-
val AddConstraint : ConstraintSolverEnv -> int -> Range.range -> OptionalTrace -> Typar -> TyparConstraint -> OperationResult<unit>
144-
val AddCxTypeEqualsType : ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> unit
145-
val AddCxTypeEqualsTypeUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
146-
val AddCxTypeEqualsTypeUndoIfFailedOrWarnings : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
147-
val AddCxTypeEqualsTypeMatchingOnlyUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
148-
val AddCxTypeMustSubsumeType : ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> TType -> unit
149-
val AddCxTypeMustSubsumeTypeUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
150-
val AddCxTypeMustSubsumeTypeMatchingOnlyUndoIfFailed : DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
151-
val AddCxMethodConstraint : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TraitConstraintInfo -> unit
152-
val AddCxTypeMustSupportNull : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit
153-
val AddCxTypeMustSupportComparison : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit
154-
val AddCxTypeMustSupportEquality : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit
155-
val AddCxTypeMustSupportDefaultCtor : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit
156-
val AddCxTypeIsReferenceType : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit
157-
val AddCxTypeIsValueType : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit
158-
val AddCxTypeIsUnmanaged : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit
159-
val AddCxTypeIsEnum : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> TType -> unit
160-
val AddCxTypeIsDelegate : DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> TType -> TType -> unit
161-
162-
val CodegenWitnessThatTypeSupportsTraitConstraint : TcValF -> TcGlobals -> ImportMap -> range -> TraitConstraintInfo -> Expr list -> OperationResult<Expr option>
163-
164-
val ChooseTyparSolutionAndSolve : ConstraintSolverState -> DisplayEnv -> Typar -> unit
165-
166-
val IsApplicableMethApprox : TcGlobals -> ImportMap -> range -> MethInfo -> TType -> bool
123+
| NoTrace
124+
| WithTrace of Trace
125+
126+
val SimplifyMeasuresInTypeScheme: TcGlobals -> bool -> Typars -> TType -> TyparConstraint list -> Typars
127+
128+
val ResolveOverloadingForCall: DisplayEnv -> ConstraintSolverState -> range -> string -> ndeep: int -> TraitConstraintInfo option -> int * int -> AccessorDomain -> CalledMeth<Expr> list -> bool -> TType option -> CalledMeth<Expr> option * OperationResult<unit>
129+
130+
val UnifyUniqueOverloading: DisplayEnv -> ConstraintSolverState -> range -> int * int -> string -> AccessorDomain -> CalledMeth<SynExpr> list -> TType -> OperationResult<bool>
131+
132+
/// Remove the global constraints where these type variables appear in the support of the constraint
133+
val EliminateConstraintsForGeneralizedTypars: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> Typars -> unit
134+
135+
val CheckDeclaredTypars: DisplayEnv -> ConstraintSolverState -> range -> Typars -> Typars -> unit
136+
137+
val AddCxTypeEqualsType: ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> unit
138+
139+
val AddCxTypeEqualsTypeUndoIfFailed: DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
140+
141+
val AddCxTypeEqualsTypeUndoIfFailedOrWarnings: DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
142+
143+
val AddCxTypeEqualsTypeMatchingOnlyUndoIfFailed: DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
144+
145+
val AddCxTypeMustSubsumeType: ContextInfo -> DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> TType -> unit
146+
147+
val AddCxTypeMustSubsumeTypeUndoIfFailed: DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
148+
149+
val AddCxTypeMustSubsumeTypeMatchingOnlyUndoIfFailed: DisplayEnv -> ConstraintSolverState -> range -> TType -> TType -> bool
150+
151+
val AddCxMethodConstraint: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TraitConstraintInfo -> unit
152+
153+
val AddCxTypeMustSupportNull: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit
154+
155+
val AddCxTypeMustSupportComparison: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit
156+
157+
val AddCxTypeMustSupportEquality: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit
158+
159+
val AddCxTypeMustSupportDefaultCtor: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit
160+
161+
val AddCxTypeIsReferenceType: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit
162+
163+
val AddCxTypeIsValueType: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit
164+
165+
val AddCxTypeIsUnmanaged: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> unit
166+
167+
val AddCxTypeIsEnum: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> TType -> unit
168+
169+
val AddCxTypeIsDelegate: DisplayEnv -> ConstraintSolverState -> range -> OptionalTrace -> TType -> TType -> TType -> unit
170+
171+
val AddCxTyparDefaultsTo: DisplayEnv -> ConstraintSolverState -> range -> ContextInfo -> Typar -> int -> TType -> unit
172+
173+
val SolveTypeAsError: DisplayEnv -> ConstraintSolverState -> range -> TType -> unit
174+
175+
val ApplyTyparDefaultAtPriority: DisplayEnv -> ConstraintSolverState -> priority: int -> Typar -> unit
176+
177+
val CodegenWitnessThatTypeSupportsTraitConstraint: TcValF -> TcGlobals -> ImportMap -> range -> TraitConstraintInfo -> Expr list -> OperationResult<Expr option>
178+
179+
val ChooseTyparSolutionAndSolve: ConstraintSolverState -> DisplayEnv -> Typar -> unit
180+
181+
val IsApplicableMethApprox: TcGlobals -> ImportMap -> range -> MethInfo -> TType -> bool
182+
183+
val CanonicalizePartialInferenceProblem: ConstraintSolverState -> DisplayEnv -> range -> Typars -> unit

‎src/fsharp/IlxGen.fs

-1
Original file line numberDiff line numberDiff line change
@@ -7754,4 +7754,3 @@ type IlxAssemblyGenerator(amap: ImportMap, tcGlobals: TcGlobals, tcVal: Constrai
77547754
/// Invert the compilation of the given value and return its current dynamic value and its compiled System.Type
77557755
member __.LookupGeneratedValue (ctxt, v) = LookupGeneratedValue amap ctxt ilxGenEnv v
77567756

7757-

‎src/fsharp/TypeChecker.fs

+15-43
Original file line numberDiff line numberDiff line change
@@ -2284,13 +2284,6 @@ module GeneralizationHelpers =
22842284
ConstraintSolver.ChooseTyparSolutionAndSolve cenv.css denv tp)
22852285
generalizedTypars
22862286

2287-
let CanonicalizePartialInferenceProblem (cenv, denv, m) tps =
2288-
// Canonicalize constraints prior to generalization
2289-
let csenv = (MakeConstraintSolverEnv ContextInfo.NoContext cenv.css m denv)
2290-
TryD (fun () -> ConstraintSolver.CanonicalizeRelevantMemberConstraints csenv 0 NoTrace tps)
2291-
(fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m)))
2292-
|> RaiseOperationResult
2293-
22942287
let ComputeAndGeneralizeGenericTypars (cenv,
22952288
denv: DisplayEnv,
22962289
m,
@@ -2333,8 +2326,7 @@ module GeneralizationHelpers =
23332326
generalizedTypars |> List.iter (SetTyparRigid cenv.g denv m)
23342327

23352328
// Generalization removes constraints related to generalized type variables
2336-
let csenv = MakeConstraintSolverEnv ContextInfo.NoContext cenv.css m denv
2337-
EliminateConstraintsForGeneralizedTypars csenv NoTrace generalizedTypars
2329+
EliminateConstraintsForGeneralizedTypars denv cenv.css m NoTrace generalizedTypars
23382330

23392331
generalizedTypars
23402332

@@ -4333,8 +4325,7 @@ let rec TcTyparConstraint ridx cenv newOk checkCxs occ (env: TcEnv) tpenv c =
43334325
| WhereTyparDefaultsToType(tp, ty, m) ->
43344326
let ty', tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv ty
43354327
let tp', tpenv = TcTypar cenv env newOk tpenv tp
4336-
let csenv = MakeConstraintSolverEnv env.eContextInfo cenv.css m env.DisplayEnv
4337-
AddConstraint csenv 0 m NoTrace tp' (TyparConstraint.DefaultsTo(ridx, ty', m)) |> CommitOperationResult
4328+
AddCxTyparDefaultsTo env.DisplayEnv cenv.css m env.eContextInfo tp' ridx ty'
43384329
tpenv
43394330

43404331
| WhereTyparSubtypeOfType(tp, ty, m) ->
@@ -5595,11 +5586,7 @@ and TcPatterns warnOnUpper cenv env vFlags s argTys args =
55955586
assert (List.length args = List.length argTys)
55965587
List.mapFold (fun s (ty, pat) -> TcPat warnOnUpper cenv env None vFlags s ty pat) s (List.zip argTys args)
55975588

5598-
5599-
and solveTypAsError cenv denv m ty =
5600-
let ty2 = NewErrorType ()
5601-
assert((destTyparTy cenv.g ty2).IsFromError)
5602-
SolveTypeEqualsTypeKeepAbbrevs (MakeConstraintSolverEnv ContextInfo.NoContext cenv.css m denv) 0 m NoTrace ty ty2 |> ignore
5589+
and solveTypAsError cenv denv m ty = ConstraintSolver.SolveTypeAsError denv cenv.css m ty
56035590

56045591
and RecordNameAndTypeResolutions_IdeallyWithoutHavingOtherEffects cenv env tpenv expr =
56055592
// This function is motivated by cases like
@@ -6782,7 +6769,7 @@ and TcObjectExprBinding cenv (env: TcEnv) implty tpenv (absSlotInfo, bind) =
67826769
| _ ->
67836770
declaredTypars
67846771
// Canonicalize constraints prior to generalization
6785-
GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv, denv, m) declaredTypars
6772+
ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css denv m declaredTypars
67866773

67876774
let freeInEnv = GeneralizationHelpers.ComputeUngeneralizableTypars env
67886775

@@ -9638,7 +9625,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela
96389625

96399626
// Canonicalize inference problem prior to '.' lookup on variable types
96409627
if isTyparTy cenv.g objExprTy then
9641-
GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv, env.DisplayEnv, mExprAndLongId) (freeInTypeLeftToRight cenv.g false objExprTy)
9628+
ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css env.DisplayEnv mExprAndLongId (freeInTypeLeftToRight cenv.g false objExprTy)
96429629

96439630
let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver mExprAndLongId ad env.NameEnv objExprTy longId findFlag false
96449631
let mExprAndItem = unionRanges mObjExpr mItem
@@ -10089,8 +10076,7 @@ and TcMethodApplication
1008910076
yield makeOneCalledMeth (minfo, pinfoOpt, false) ]
1009010077

1009110078
let uniquelyResolved =
10092-
let csenv = MakeConstraintSolverEnv ContextInfo.NoContext cenv.css mMethExpr denv
10093-
UnifyUniqueOverloading csenv callerArgCounts methodName ad preArgumentTypeCheckingCalledMethGroup returnTy
10079+
UnifyUniqueOverloading denv cenv.css mMethExpr callerArgCounts methodName ad preArgumentTypeCheckingCalledMethGroup returnTy
1009410080

1009510081
uniquelyResolved, preArgumentTypeCheckingCalledMethGroup
1009610082

@@ -10182,17 +10168,15 @@ and TcMethodApplication
1018210168
CalledMeth<Expr>(cenv.infoReader, Some(env.NameEnv), isCheckingAttributeCall, FreshenMethInfo, mMethExpr, ad, minfo, minst, callerTyArgs, pinfoOpt, callerObjArgTys, callerArgs, usesParamArrayConversion, true, objTyOpt))
1018310169

1018410170
let callerArgCounts = (unnamedCurriedCallerArgs.Length, namedCurriedCallerArgs.Length)
10185-
let csenv = MakeConstraintSolverEnv ContextInfo.NoContext cenv.css mMethExpr denv
1018610171

1018710172
// Commit unassociated constraints prior to member overload resolution where there is ambiguity
1018810173
// about the possible target of the call.
1018910174
if not uniquelyResolved then
10190-
GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv, denv, mItem)
10175+
ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css denv mItem
1019110176
(//freeInTypeLeftToRight cenv.g false returnTy @
1019210177
(unnamedCurriedCallerArgs |> List.collectSquared (fun callerArg -> freeInTypeLeftToRight cenv.g false callerArg.Type)))
1019310178

10194-
let result, errors =
10195-
ResolveOverloading csenv NoTrace methodName 0 None callerArgCounts ad postArgumentTypeCheckingCalledMethGroup true (Some returnTy)
10179+
let result, errors = ResolveOverloadingForCall denv cenv.css mMethExpr methodName 0 None callerArgCounts ad postArgumentTypeCheckingCalledMethGroup true (Some returnTy)
1019610180

1019710181
match afterResolution, result with
1019810182
| AfterResolution.DoNothing, _ -> ()
@@ -11150,7 +11134,7 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (synBinds, synBinds
1115011134

1115111135
// Canonicalize constraints prior to generalization
1115211136
let denv = env.DisplayEnv
11153-
GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv, denv, synBindsRange)
11137+
ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css denv synBindsRange
1115411138
(checkedBinds |> List.collect (fun tbinfo ->
1115511139
let (CheckedBindingInfo(_, _, _, _, flex, _, _, _, tauTy, _, _, _, _, _)) = tbinfo
1115611140
let (ExplicitTyparInfo(_, declaredTypars, _)) = flex
@@ -12025,7 +12009,7 @@ and TcIncrementalLetRecGeneralization cenv scopem
1202512009
else
1202612010

1202712011
let supportForBindings = newGeneralizableBindings |> List.collect (TcLetrecComputeSupportForBinding cenv)
12028-
GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv, denv, scopem) supportForBindings
12012+
ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css denv scopem supportForBindings
1202912013

1203012014
let generalizedTyparsL = newGeneralizableBindings |> List.map (TcLetrecComputeAndGeneralizeGenericTyparsForBinding cenv denv freeInEnv)
1203112015

@@ -17530,27 +17514,15 @@ let ApplyDefaults cenv g denvAtEnd m mexpr extraAttribs =
1753017514
try
1753117515
let unsolved = FSharp.Compiler.FindUnsolved.UnsolvedTyparsOfModuleDef g cenv.amap denvAtEnd (mexpr, extraAttribs)
1753217516

17533-
GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv, denvAtEnd, m) unsolved
17517+
ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css denvAtEnd m unsolved
1753417518

17535-
let applyDefaults priority =
17536-
unsolved |> List.iter (fun tp ->
17519+
// The priority order comes from the order of declaration of the defaults in FSharp.Core.
17520+
for priority = 10 downto 0 do
17521+
unsolved |> List.iter (fun tp ->
1753717522
if not tp.IsSolved then
1753817523
// Apply the first default. If we're defaulting one type variable to another then
1753917524
// the defaults will be propagated to the new type variable.
17540-
tp.Constraints |> List.iter (fun tpc ->
17541-
match tpc with
17542-
| TyparConstraint.DefaultsTo(priority2, ty2, m) when priority2 = priority ->
17543-
let ty1 = mkTyparTy tp
17544-
if not tp.IsSolved && not (typeEquiv cenv.g ty1 ty2) then
17545-
let csenv = MakeConstraintSolverEnv ContextInfo.NoContext cenv.css m denvAtEnd
17546-
TryD (fun () -> ConstraintSolver.SolveTyparEqualsType csenv 0 m NoTrace ty1 ty2)
17547-
(fun e -> solveTypAsError cenv denvAtEnd m ty1
17548-
ErrorD(ErrorFromApplyingDefault(g, denvAtEnd, tp, ty2, e, m)))
17549-
|> RaiseOperationResult
17550-
| _ -> ()))
17551-
17552-
for priority = 10 downto 0 do
17553-
applyDefaults priority
17525+
ConstraintSolver.ApplyTyparDefaultAtPriority denvAtEnd cenv.css priority tp)
1755417526

1755517527
// OK, now apply defaults for any unsolved HeadTypeStaticReq
1755617528
unsolved |> List.iter (fun tp ->

0 commit comments

Comments
 (0)