Skip to content

Commit 0ae8c83

Browse files
NinoFlorisNinoFloris
authored
Fix issues around type directed conversion (#13673)
1 parent af0015e commit 0ae8c83

File tree

7 files changed

+519
-75
lines changed

7 files changed

+519
-75
lines changed

‎src/Compiler/Checking/CheckExpressions.fs‎

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -453,7 +453,7 @@ let UnifyOverallType (cenv: cenv) (env: TcEnv) m overallTy actualTy =
453453
| None -> ()
454454

455455
match usesTDC with
456-
| TypeDirectedConversionUsed.Yes warn -> warning(warn env.DisplayEnv)
456+
| TypeDirectedConversionUsed.Yes(warn, _) -> warning(warn env.DisplayEnv)
457457
| TypeDirectedConversionUsed.No -> ()
458458

459459
if AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m reqdTy2 actualTy then
@@ -5385,7 +5385,7 @@ and TcAdjustExprForTypeDirectedConversions (cenv: cenv) (overallTy: OverallTy) a
53855385
let g = cenv.g
53865386

53875387
match overallTy with
5388-
| MustConvertTo (_, reqdTy) when g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions ->
5388+
| MustConvertTo (isMethodArg, reqdTy) when g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions || (g.langVersion.SupportsFeature LanguageFeature.NullableOptionalInterop && isMethodArg) ->
53895389
let tcVal = LightweightTcValForUsingInBuildMethodCall g
53905390
AdjustExprForTypeDirectedConversions tcVal g cenv.amap cenv.infoReader env.AccessRights reqdTy actualTy m expr
53915391
| _ ->
@@ -9704,12 +9704,9 @@ and TcMethodApplication
97049704
let expr = mkLetsBind mMethExpr outArgTmpBinds expr
97059705
expr, tyOfExpr g expr
97069706

9707-
// Subsumption or conversion to return type
9708-
let callExpr2b = TcAdjustExprForTypeDirectedConversions cenv returnTy exprTy env mMethExpr callExpr2
9709-
97109707
// Handle post-hoc property assignments
9711-
let setterExprPrebinders, callExpr3 =
9712-
let expr = callExpr2b
9708+
let setterExprPrebinders, callExpr2b =
9709+
let expr = callExpr2
97139710

97149711
CheckRequiredProperties g env cenv finalCalledMethInfo finalAssignedItemSetters mMethExpr
97159712

@@ -9731,6 +9728,9 @@ and TcMethodApplication
97319728
let expr = mkCompGenLet mMethExpr objv expr (mkCompGenSequential mMethExpr propSetExpr objExpr)
97329729
setterExprPrebinders, expr
97339730

9731+
// Subsumption or conversion to return type
9732+
let callExpr3 = TcAdjustExprForTypeDirectedConversions cenv returnTy exprTy env mMethExpr callExpr2b
9733+
97349734
// Build the lambda expression if any, if the method is used as a first-class value
97359735
let callExpr4 =
97369736
let expr = callExpr3

‎src/Compiler/Checking/ConstraintSolver.fs‎

Lines changed: 18 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -2695,21 +2695,21 @@ and AddWrappedContextualSubsumptionReport (csenv: ConstraintSolverEnv) ndeep m c
26952695
| _ -> ErrorD (wrapper (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, csenv.eContextInfo, m)))
26962696

26972697
/// Assert a subtype constraint
2698-
and SolveTypeSubsumesTypeWithWrappedContextualReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln ty1 ty2 wrapper =
2698+
and SolveTypeSubsumesTypeWithWrappedContextualReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln origTy1 ty1 ty2 wrapper =
26992699
// Due to the legacy of the change https://github.com/dotnet/fsharp/pull/1650,
27002700
// when doing nested, speculative overload resolution, we ignore failed member constraints and continue. The
27012701
// constraint is not recorded for later solution.
27022702
if csenv.IsSpeculativeForMethodOverloading then
27032703
IgnoreFailedMemberConstraintResolution
27042704
(fun () -> SolveTypeSubsumesTypeKeepAbbrevs csenv ndeep m trace cxsln ty1 ty2)
2705-
(fun res -> AddWrappedContextualSubsumptionReport csenv ndeep m cxsln ty1 ty2 res wrapper)
2705+
(fun res -> AddWrappedContextualSubsumptionReport csenv ndeep m cxsln (defaultArg origTy1 ty1) ty2 res wrapper)
27062706
else
27072707
PostponeOnFailedMemberConstraintResolution csenv trace
27082708
(fun csenv -> SolveTypeSubsumesTypeKeepAbbrevs csenv ndeep m trace cxsln ty1 ty2)
2709-
(fun res -> AddWrappedContextualSubsumptionReport csenv ndeep m cxsln ty1 ty2 res wrapper)
2709+
(fun res -> AddWrappedContextualSubsumptionReport csenv ndeep m cxsln (defaultArg origTy1 ty1) ty2 res wrapper)
27102710

2711-
and SolveTypeSubsumesTypeWithReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln ty1 ty2 =
2712-
SolveTypeSubsumesTypeWithWrappedContextualReport csenv ndeep m trace cxsln ty1 ty2 id
2711+
and SolveTypeSubsumesTypeWithReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln origTy1 ty1 ty2 =
2712+
SolveTypeSubsumesTypeWithWrappedContextualReport csenv ndeep m trace cxsln origTy1 ty1 ty2 id
27132713

27142714
and SolveTypeEqualsTypeWithReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln actualTy expectedTy =
27152715
TryD
@@ -2738,9 +2738,9 @@ and ArgsMustSubsumeOrConvert
27382738
msg csenv.DisplayEnv
27392739
| None -> ()
27402740
match usesTDC with
2741-
| TypeDirectedConversionUsed.Yes warn -> do! WarnD(warn csenv.DisplayEnv)
2741+
| TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv)
27422742
| TypeDirectedConversionUsed.No -> ()
2743-
do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln calledArgTy callerArg.CallerArgumentType
2743+
do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln (Some calledArg.CalledArgumentType) calledArgTy callerArg.CallerArgumentType
27442744
if calledArg.IsParamArray && isArray1DTy g calledArgTy && not (isArray1DTy g callerArg.CallerArgumentType) then
27452745
return! ErrorD(Error(FSComp.SR.csMethodExpectsParams(), m))
27462746
else
@@ -2769,9 +2769,9 @@ and ArgsMustSubsumeOrConvertWithContextualReport
27692769
msg csenv.DisplayEnv
27702770
| None -> ()
27712771
match usesTDC with
2772-
| TypeDirectedConversionUsed.Yes warn -> do! WarnD(warn csenv.DisplayEnv)
2772+
| TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv)
27732773
| TypeDirectedConversionUsed.No -> ()
2774-
do! SolveTypeSubsumesTypeWithWrappedContextualReport csenv ndeep m trace cxsln calledArgTy callerArgTy (fun e -> ArgDoesNotMatchError(e :?> _, calledMeth, calledArg, callerArg))
2774+
do! SolveTypeSubsumesTypeWithWrappedContextualReport csenv ndeep m trace cxsln (Some calledArg.CalledArgumentType) calledArgTy callerArgTy (fun e -> ArgDoesNotMatchError(e :?> _, calledMeth, calledArg, callerArg))
27752775
return usesTDC
27762776
}
27772777

@@ -2783,7 +2783,7 @@ and TypesEquiv csenv ndeep trace cxsln ty1 ty2 =
27832783

27842784
and TypesMustSubsume (csenv: ConstraintSolverEnv) ndeep trace cxsln m calledArgTy callerArgTy =
27852785
trackErrors {
2786-
do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln calledArgTy callerArgTy
2786+
do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln None calledArgTy callerArgTy
27872787
return TypeDirectedConversionUsed.No
27882788
}
27892789

@@ -2796,9 +2796,9 @@ and ReturnTypesMustSubsumeOrConvert (csenv: ConstraintSolverEnv) ad ndeep trace
27962796
msg csenv.DisplayEnv
27972797
| None -> ()
27982798
match usesTDC with
2799-
| TypeDirectedConversionUsed.Yes warn -> do! WarnD(warn csenv.DisplayEnv)
2799+
| TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv)
28002800
| TypeDirectedConversionUsed.No -> ()
2801-
do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln reqdTy actualTy
2801+
do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln None reqdTy actualTy
28022802
return usesTDC
28032803
}
28042804

@@ -2813,7 +2813,7 @@ and ArgsEquivOrConvert (csenv: ConstraintSolverEnv) ad ndeep trace cxsln isConst
28132813
msg csenv.DisplayEnv
28142814
| None -> ()
28152815
match usesTDC with
2816-
| TypeDirectedConversionUsed.Yes warn -> do! WarnD(warn csenv.DisplayEnv)
2816+
| TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv)
28172817
| TypeDirectedConversionUsed.No -> ()
28182818
if not (typeEquiv csenv.g calledArgTy callerArgTy) then
28192819
return! ErrorD(Error(FSComp.SR.csArgumentTypesDoNotMatch(), m))
@@ -3223,6 +3223,10 @@ and GetMostApplicableOverload csenv ndeep candidates applicableMeths calledMethG
32233223
// Prefer methods that don't use type-directed conversion
32243224
let c = compare (match usesTDC1 with TypeDirectedConversionUsed.No -> 1 | _ -> 0) (match usesTDC2 with TypeDirectedConversionUsed.No -> 1 | _ -> 0)
32253225
if c <> 0 then c else
3226+
3227+
// Prefer methods that need less type-directed conversion
3228+
let c = compare (match usesTDC1 with TypeDirectedConversionUsed.Yes(_, false) -> 1 | _ -> 0) (match usesTDC2 with TypeDirectedConversionUsed.Yes(_, false) -> 1 | _ -> 0)
3229+
if c <> 0 then c else
32263230

32273231
// Prefer methods that don't give "this code is less generic" warnings
32283232
// Note: Relies on 'compare' respecting true > false
@@ -3519,7 +3523,7 @@ let AddCxTypeMustSubsumeTypeMatchingOnlyUndoIfFailed denv css m extraRigidTypars
35193523

35203524
let AddCxTypeMustSubsumeType contextInfo denv css m trace ty1 ty2 =
35213525
let csenv = MakeConstraintSolverEnv contextInfo css m denv
3522-
SolveTypeSubsumesTypeWithReport csenv 0 m trace None ty1 ty2
3526+
SolveTypeSubsumesTypeWithReport csenv 0 m trace None None ty1 ty2
35233527
|> RaiseOperationResult
35243528

35253529
let AddCxMethodConstraint denv css m trace traitInfo =

‎src/Compiler/Checking/MethodCalls.fs‎

Lines changed: 41 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -236,12 +236,15 @@ type TypeDirectedConversion =
236236

237237
[<RequireQualifiedAccess>]
238238
type TypeDirectedConversionUsed =
239-
| Yes of (DisplayEnv -> exn)
239+
| Yes of (DisplayEnv -> exn) * isTwoStepConversion: bool
240240
| No
241241
static member Combine a b =
242-
match a with
243-
| Yes _ -> a
244-
| No -> b
242+
match a, b with
243+
| Yes(_,true), _ -> a
244+
| _, Yes(_,true) -> b
245+
| Yes _, _ -> a
246+
| _, Yes _ -> b
247+
| No, No -> a
245248

246249
let MapCombineTDCD mapper xs =
247250
MapReduceD mapper TypeDirectedConversionUsed.No TypeDirectedConversionUsed.Combine xs
@@ -279,21 +282,33 @@ let rec AdjustRequiredTypeForTypeDirectedConversions (infoReader: InfoReader) ad
279282

280283
// Adhoc int32 --> int64
281284
elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions && typeEquiv g g.int64_ty reqdTy && typeEquiv g g.int32_ty actualTy then
282-
g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn), None
285+
g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false), None
283286

284287
// Adhoc int32 --> nativeint
285288
elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions && typeEquiv g g.nativeint_ty reqdTy && typeEquiv g g.int32_ty actualTy then
286-
g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn), None
289+
g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false), None
287290

288291
// Adhoc int32 --> float64
289292
elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions && typeEquiv g g.float_ty reqdTy && typeEquiv g g.int32_ty actualTy then
290-
g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn), None
293+
g.int32_ty, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false), None
291294

295+
elif g.langVersion.SupportsFeature LanguageFeature.NullableOptionalInterop && isMethodArg && isNullableTy g reqdTy && not (isNullableTy g actualTy) then
296+
let underlyingTy = destNullableTy g reqdTy
297+
// shortcut
298+
if typeEquiv g underlyingTy actualTy then
299+
actualTy, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false), None
300+
else
301+
let adjustedTy, _, _ = AdjustRequiredTypeForTypeDirectedConversions infoReader ad isMethodArg isConstraint underlyingTy actualTy m
302+
if typeEquiv g adjustedTy actualTy then
303+
actualTy, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, true), None
304+
else
305+
reqdTy, TypeDirectedConversionUsed.No, None
306+
292307
// Adhoc based on op_Implicit, perhaps returing a new equational type constraint to
293308
// eliminate articifical constrained type variables.
294309
elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions then
295310
match TryFindRelevantImplicitConversion infoReader ad reqdTy actualTy m with
296-
| Some (minfo, _staticTy, eqn) -> actualTy, TypeDirectedConversionUsed.Yes(warn (TypeDirectedConversion.Implicit minfo)), Some eqn
311+
| Some (minfo, _staticTy, eqn) -> actualTy, TypeDirectedConversionUsed.Yes(warn (TypeDirectedConversion.Implicit minfo), false), Some eqn
297312
| None -> reqdTy, TypeDirectedConversionUsed.No, None
298313

299314
else reqdTy, TypeDirectedConversionUsed.No, None
@@ -352,9 +367,8 @@ let AdjustCalledArgTypeForOptionals (infoReader: InfoReader) ad enforceNullableO
352367

353368
// If inference has worked out it's a struct (e.g. an int) then use this
354369
elif isStructTy g callerArgTy then
355-
let calledArgTy2 = destNullableTy g calledArgTy
356-
AdjustRequiredTypeForTypeDirectedConversions infoReader ad true false calledArgTy2 callerArgTy m
357-
370+
AdjustRequiredTypeForTypeDirectedConversions infoReader ad true false calledArgTy callerArgTy m
371+
358372
// If neither and we are at the end of overload resolution then use the Nullable
359373
elif enforceNullableOptionalsKnownTypes then
360374
calledArgTy, TypeDirectedConversionUsed.No, None
@@ -1305,6 +1319,16 @@ let rec AdjustExprForTypeDirectedConversions tcVal (g: TcGlobals) amap infoReade
13051319

13061320
mkCallToDoubleOperator g m actualTy expr
13071321

1322+
elif g.langVersion.SupportsFeature LanguageFeature.NullableOptionalInterop &&
1323+
isNullableTy g reqdTy && not (isNullableTy g actualTy) then
1324+
1325+
let underlyingTy = destNullableTy g reqdTy
1326+
let adjustedExpr = AdjustExprForTypeDirectedConversions tcVal g amap infoReader ad underlyingTy actualTy m expr
1327+
let adjustedActualTy = tyOfExpr g adjustedExpr
1328+
1329+
let minfo = GetIntrinsicConstructorInfosOfType infoReader m reqdTy |> List.head
1330+
let callerArgExprCoerced = mkCoerceIfNeeded g underlyingTy adjustedActualTy adjustedExpr
1331+
MakeMethInfoCall amap m minfo [] [callerArgExprCoerced] None
13081332
else
13091333
match TryFindRelevantImplicitConversion infoReader ad reqdTy actualTy m with
13101334
| Some (minfo, staticTy, _) ->
@@ -1313,9 +1337,7 @@ let rec AdjustExprForTypeDirectedConversions tcVal (g: TcGlobals) amap infoReade
13131337
let callExpr, _ = BuildMethodCall tcVal g amap Mutates.NeverMutates m false minfo ValUseFlag.NormalValUse [] [] [expr] staticTyOpt
13141338
assert (let resTy = tyOfExpr g callExpr in typeEquiv g reqdTy resTy)
13151339
callExpr
1316-
| None -> mkCoerceIfNeeded g reqdTy actualTy expr
1317-
// TODO: consider Nullable
1318-
1340+
| None -> mkCoerceIfNeeded g reqdTy actualTy expr
13191341

13201342
// Handle adhoc argument conversions
13211343
let AdjustCallerArgExpr tcVal (g: TcGlobals) amap infoReader ad isOutArg calledArgTy (reflArgInfo: ReflectedArgInfo) callerArgTy m callerArgExpr =
@@ -1450,17 +1472,6 @@ let GetDefaultExpressionForOptionalArg tcFieldInit g (calledArg: CalledArg) eCal
14501472
let callerArg = CallerArg(calledArgTy, mMethExpr, false, expr)
14511473
preBinder, { NamedArgIdOpt = None; CalledArg = calledArg; CallerArg = callerArg }
14521474

1453-
let MakeNullableExprIfNeeded (infoReader: InfoReader) calledArgTy callerArgTy callerArgExpr m =
1454-
let g = infoReader.g
1455-
let amap = infoReader.amap
1456-
if isNullableTy g callerArgTy then
1457-
callerArgExpr
1458-
else
1459-
let calledNonOptTy = destNullableTy g calledArgTy
1460-
let minfo = GetIntrinsicConstructorInfosOfType infoReader m calledArgTy |> List.head
1461-
let callerArgExprCoerced = mkCoerceIfNeeded g calledNonOptTy callerArgTy callerArgExpr
1462-
MakeMethInfoCall amap m minfo [] [callerArgExprCoerced] None
1463-
14641475
// Adjust all the optional arguments, filling in values for defaults,
14651476
let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader) ad (assignedArg: AssignedCalledArg<_>) =
14661477
let g = infoReader.g
@@ -1492,14 +1503,9 @@ let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader:
14921503
| NotOptional ->
14931504
// T --> Nullable<T> widening at callsites
14941505
if isOptCallerArg then errorR(Error(FSComp.SR.tcFormalArgumentIsNotOptional(), m))
1495-
if isNullableTy g calledArgTy then
1496-
if isNullableTy g callerArgTy then
1497-
callerArgExpr
1498-
else
1499-
let calledNonOptTy = destNullableTy g calledArgTy
1500-
let _, callerArgExpr2 = AdjustCallerArgExpr tcVal g amap infoReader ad isOutArg calledNonOptTy reflArgInfo callerArgTy m callerArgExpr
1501-
let callerArgTy2 = tyOfExpr g callerArgExpr2
1502-
MakeNullableExprIfNeeded infoReader calledArgTy callerArgTy2 callerArgExpr2 m
1506+
if isNullableTy g calledArgTy then
1507+
// AdjustCallerArgExpr later on will deal with the nullable conversion
1508+
callerArgExpr
15031509
else
15041510
failwith "unreachable" // see case above
15051511

@@ -1521,21 +1527,8 @@ let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader:
15211527
// This should be unreachable but the error will be reported elsewhere
15221528
callerArgExpr
15231529
else
1524-
if isNullableTy g calledArgTy then
1525-
if isNullableTy g callerArgTy then
1526-
// CSharpMethod(x=b) when 'x' has nullable type
1527-
// CSharpMethod(x=b) when both 'x' and 'b' have nullable type --> CSharpMethod(x=b)
1528-
callerArgExpr
1529-
else
1530-
// CSharpMethod(x=b) when 'x' has nullable type and 'b' does not --> CSharpMethod(x=Nullable(b))
1531-
let calledNonOptTy = destNullableTy g calledArgTy
1532-
let _, callerArgExpr2 = AdjustCallerArgExpr tcVal g amap infoReader ad isOutArg calledNonOptTy reflArgInfo callerArgTy m callerArgExpr
1533-
let callerArgTy2 = tyOfExpr g callerArgExpr2
1534-
MakeNullableExprIfNeeded infoReader calledArgTy callerArgTy2 callerArgExpr2 m
1535-
else
1536-
// CSharpMethod(x=b) --> CSharpMethod(?x=b)
1537-
let _, callerArgExpr2 = AdjustCallerArgExpr tcVal g amap infoReader ad isOutArg calledArgTy reflArgInfo callerArgTy m callerArgExpr
1538-
callerArgExpr2
1530+
// AdjustCallerArgExpr later on will deal with any nullable conversion
1531+
callerArgExpr
15391532

15401533
| CalleeSide ->
15411534
if isOptCallerArg then

‎src/Compiler/Checking/MethodCalls.fsi‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -119,7 +119,7 @@ type CallerArgs<'T> =
119119
/// has been used in F# code
120120
[<RequireQualifiedAccess>]
121121
type TypeDirectedConversionUsed =
122-
| Yes of (DisplayEnv -> exn)
122+
| Yes of (DisplayEnv -> exn) * isTwoStepConversion: bool
123123
| No
124124

125125
static member Combine: TypeDirectedConversionUsed -> TypeDirectedConversionUsed -> TypeDirectedConversionUsed

0 commit comments

Comments
 (0)