Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix issues around type directed conversion #13673

Merged
merged 11 commits into from
Aug 22, 2022
14 changes: 7 additions & 7 deletions src/Compiler/Checking/CheckExpressions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -453,7 +453,7 @@ let UnifyOverallType (cenv: cenv) (env: TcEnv) m overallTy actualTy =
| None -> ()

match usesTDC with
| TypeDirectedConversionUsed.Yes warn -> warning(warn env.DisplayEnv)
| TypeDirectedConversionUsed.Yes(warn, _) -> warning(warn env.DisplayEnv)
| TypeDirectedConversionUsed.No -> ()

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

match overallTy with
| MustConvertTo (_, reqdTy) when g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions ->
| MustConvertTo (isMethodArg, reqdTy) when g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions || (g.langVersion.SupportsFeature LanguageFeature.NullableOptionalInterop && isMethodArg) ->
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Thinking aloud: The conditional here is now quite complex - maybe it would have been better originally to just always call AdjustExprForTypeDirectedConversions and have the conditions on the specific rules in that method.

No need to change anything here though.

let tcVal = LightweightTcValForUsingInBuildMethodCall g
AdjustExprForTypeDirectedConversions tcVal g cenv.amap cenv.infoReader env.AccessRights reqdTy actualTy m expr
| _ ->
Expand Down Expand Up @@ -9704,12 +9704,9 @@ and TcMethodApplication
let expr = mkLetsBind mMethExpr outArgTmpBinds expr
expr, tyOfExpr g expr

// Subsumption or conversion to return type
let callExpr2b = TcAdjustExprForTypeDirectedConversions cenv returnTy exprTy env mMethExpr callExpr2

// Handle post-hoc property assignments
let setterExprPrebinders, callExpr3 =
let expr = callExpr2b
let setterExprPrebinders, callExpr2b =
let expr = callExpr2

CheckRequiredProperties g env cenv finalCalledMethInfo finalAssignedItemSetters mMethExpr

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

// Subsumption or conversion to return type
let callExpr3 = TcAdjustExprForTypeDirectedConversions cenv returnTy exprTy env mMethExpr callExpr2b

// Build the lambda expression if any, if the method is used as a first-class value
let callExpr4 =
let expr = callExpr3
Expand Down
32 changes: 18 additions & 14 deletions src/Compiler/Checking/ConstraintSolver.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2695,21 +2695,21 @@ and AddWrappedContextualSubsumptionReport (csenv: ConstraintSolverEnv) ndeep m c
| _ -> ErrorD (wrapper (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, csenv.eContextInfo, m)))

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

and SolveTypeSubsumesTypeWithReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln ty1 ty2 =
SolveTypeSubsumesTypeWithWrappedContextualReport csenv ndeep m trace cxsln ty1 ty2 id
and SolveTypeSubsumesTypeWithReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln origTy1 ty1 ty2 =
SolveTypeSubsumesTypeWithWrappedContextualReport csenv ndeep m trace cxsln origTy1 ty1 ty2 id

and SolveTypeEqualsTypeWithReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln actualTy expectedTy =
TryD
Expand Down Expand Up @@ -2738,9 +2738,9 @@ and ArgsMustSubsumeOrConvert
msg csenv.DisplayEnv
| None -> ()
match usesTDC with
| TypeDirectedConversionUsed.Yes warn -> do! WarnD(warn csenv.DisplayEnv)
| TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv)
| TypeDirectedConversionUsed.No -> ()
do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln calledArgTy callerArg.CallerArgumentType
do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln (Some calledArg.CalledArgumentType) calledArgTy callerArg.CallerArgumentType
if calledArg.IsParamArray && isArray1DTy g calledArgTy && not (isArray1DTy g callerArg.CallerArgumentType) then
return! ErrorD(Error(FSComp.SR.csMethodExpectsParams(), m))
else
Expand Down Expand Up @@ -2769,9 +2769,9 @@ and ArgsMustSubsumeOrConvertWithContextualReport
msg csenv.DisplayEnv
| None -> ()
match usesTDC with
| TypeDirectedConversionUsed.Yes warn -> do! WarnD(warn csenv.DisplayEnv)
| TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv)
| TypeDirectedConversionUsed.No -> ()
do! SolveTypeSubsumesTypeWithWrappedContextualReport csenv ndeep m trace cxsln calledArgTy callerArgTy (fun e -> ArgDoesNotMatchError(e :?> _, calledMeth, calledArg, callerArg))
do! SolveTypeSubsumesTypeWithWrappedContextualReport csenv ndeep m trace cxsln (Some calledArg.CalledArgumentType) calledArgTy callerArgTy (fun e -> ArgDoesNotMatchError(e :?> _, calledMeth, calledArg, callerArg))
return usesTDC
}

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

and TypesMustSubsume (csenv: ConstraintSolverEnv) ndeep trace cxsln m calledArgTy callerArgTy =
trackErrors {
do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln calledArgTy callerArgTy
do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln None calledArgTy callerArgTy
return TypeDirectedConversionUsed.No
}

Expand All @@ -2796,9 +2796,9 @@ and ReturnTypesMustSubsumeOrConvert (csenv: ConstraintSolverEnv) ad ndeep trace
msg csenv.DisplayEnv
| None -> ()
match usesTDC with
| TypeDirectedConversionUsed.Yes warn -> do! WarnD(warn csenv.DisplayEnv)
| TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv)
| TypeDirectedConversionUsed.No -> ()
do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln reqdTy actualTy
do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln None reqdTy actualTy
return usesTDC
}

Expand All @@ -2813,7 +2813,7 @@ and ArgsEquivOrConvert (csenv: ConstraintSolverEnv) ad ndeep trace cxsln isConst
msg csenv.DisplayEnv
| None -> ()
match usesTDC with
| TypeDirectedConversionUsed.Yes warn -> do! WarnD(warn csenv.DisplayEnv)
| TypeDirectedConversionUsed.Yes(warn, _) -> do! WarnD(warn csenv.DisplayEnv)
| TypeDirectedConversionUsed.No -> ()
if not (typeEquiv csenv.g calledArgTy callerArgTy) then
return! ErrorD(Error(FSComp.SR.csArgumentTypesDoNotMatch(), m))
Expand Down Expand Up @@ -3223,6 +3223,10 @@ and GetMostApplicableOverload csenv ndeep candidates applicableMeths calledMethG
// Prefer methods that don't use type-directed conversion
let c = compare (match usesTDC1 with TypeDirectedConversionUsed.No -> 1 | _ -> 0) (match usesTDC2 with TypeDirectedConversionUsed.No -> 1 | _ -> 0)
if c <> 0 then c else

// Prefer methods that need less type-directed conversion
let c = compare (match usesTDC1 with TypeDirectedConversionUsed.Yes(_, false) -> 1 | _ -> 0) (match usesTDC2 with TypeDirectedConversionUsed.Yes(_, false) -> 1 | _ -> 0)
if c <> 0 then c else

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

let AddCxTypeMustSubsumeType contextInfo denv css m trace ty1 ty2 =
let csenv = MakeConstraintSolverEnv contextInfo css m denv
SolveTypeSubsumesTypeWithReport csenv 0 m trace None ty1 ty2
SolveTypeSubsumesTypeWithReport csenv 0 m trace None None ty1 ty2
|> RaiseOperationResult

let AddCxMethodConstraint denv css m trace traitInfo =
Expand Down
89 changes: 41 additions & 48 deletions src/Compiler/Checking/MethodCalls.fs
Original file line number Diff line number Diff line change
Expand Up @@ -236,12 +236,15 @@ type TypeDirectedConversion =

[<RequireQualifiedAccess>]
type TypeDirectedConversionUsed =
| Yes of (DisplayEnv -> exn)
| Yes of (DisplayEnv -> exn) * isTwoStepConversion: bool
| No
static member Combine a b =
match a with
| Yes _ -> a
| No -> b
match a, b with
| Yes(_,true), _ -> a
| _, Yes(_,true) -> b
| Yes _, _ -> a
| _, Yes _ -> b
| No, No -> a

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

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

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

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

elif g.langVersion.SupportsFeature LanguageFeature.NullableOptionalInterop && isMethodArg && isNullableTy g reqdTy && not (isNullableTy g actualTy) then
dsyme marked this conversation as resolved.
Show resolved Hide resolved
let underlyingTy = destNullableTy g reqdTy
// shortcut
if typeEquiv g underlyingTy actualTy then
actualTy, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, false), None
else
let adjustedTy, _, _ = AdjustRequiredTypeForTypeDirectedConversions infoReader ad isMethodArg isConstraint underlyingTy actualTy m
if typeEquiv g adjustedTy actualTy then
actualTy, TypeDirectedConversionUsed.Yes(warn TypeDirectedConversion.BuiltIn, true), None
else
reqdTy, TypeDirectedConversionUsed.No, None

// Adhoc based on op_Implicit, perhaps returing a new equational type constraint to
// eliminate articifical constrained type variables.
elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions then
match TryFindRelevantImplicitConversion infoReader ad reqdTy actualTy m with
| Some (minfo, _staticTy, eqn) -> actualTy, TypeDirectedConversionUsed.Yes(warn (TypeDirectedConversion.Implicit minfo)), Some eqn
| Some (minfo, _staticTy, eqn) -> actualTy, TypeDirectedConversionUsed.Yes(warn (TypeDirectedConversion.Implicit minfo), false), Some eqn
| None -> reqdTy, TypeDirectedConversionUsed.No, None

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

// If inference has worked out it's a struct (e.g. an int) then use this
elif isStructTy g callerArgTy then
let calledArgTy2 = destNullableTy g calledArgTy
AdjustRequiredTypeForTypeDirectedConversions infoReader ad true false calledArgTy2 callerArgTy m

AdjustRequiredTypeForTypeDirectedConversions infoReader ad true false calledArgTy callerArgTy m
NinoFloris marked this conversation as resolved.
Show resolved Hide resolved

// If neither and we are at the end of overload resolution then use the Nullable
elif enforceNullableOptionalsKnownTypes then
calledArgTy, TypeDirectedConversionUsed.No, None
Expand Down Expand Up @@ -1305,6 +1319,16 @@ let rec AdjustExprForTypeDirectedConversions tcVal (g: TcGlobals) amap infoReade

mkCallToDoubleOperator g m actualTy expr

elif g.langVersion.SupportsFeature LanguageFeature.NullableOptionalInterop &&
isNullableTy g reqdTy && not (isNullableTy g actualTy) then

let underlyingTy = destNullableTy g reqdTy
let adjustedExpr = AdjustExprForTypeDirectedConversions tcVal g amap infoReader ad underlyingTy actualTy m expr
let adjustedActualTy = tyOfExpr g adjustedExpr

let minfo = GetIntrinsicConstructorInfosOfType infoReader m reqdTy |> List.head
let callerArgExprCoerced = mkCoerceIfNeeded g underlyingTy adjustedActualTy adjustedExpr
MakeMethInfoCall amap m minfo [] [callerArgExprCoerced] None
else
match TryFindRelevantImplicitConversion infoReader ad reqdTy actualTy m with
| Some (minfo, staticTy, _) ->
Expand All @@ -1313,9 +1337,7 @@ let rec AdjustExprForTypeDirectedConversions tcVal (g: TcGlobals) amap infoReade
let callExpr, _ = BuildMethodCall tcVal g amap Mutates.NeverMutates m false minfo ValUseFlag.NormalValUse [] [] [expr] staticTyOpt
assert (let resTy = tyOfExpr g callExpr in typeEquiv g reqdTy resTy)
callExpr
| None -> mkCoerceIfNeeded g reqdTy actualTy expr
// TODO: consider Nullable

| None -> mkCoerceIfNeeded g reqdTy actualTy expr

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

let MakeNullableExprIfNeeded (infoReader: InfoReader) calledArgTy callerArgTy callerArgExpr m =
let g = infoReader.g
let amap = infoReader.amap
if isNullableTy g callerArgTy then
callerArgExpr
else
let calledNonOptTy = destNullableTy g calledArgTy
let minfo = GetIntrinsicConstructorInfosOfType infoReader m calledArgTy |> List.head
let callerArgExprCoerced = mkCoerceIfNeeded g calledNonOptTy callerArgTy callerArgExpr
MakeMethInfoCall amap m minfo [] [callerArgExprCoerced] None

// Adjust all the optional arguments, filling in values for defaults,
let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader: InfoReader) ad (assignedArg: AssignedCalledArg<_>) =
let g = infoReader.g
Expand Down Expand Up @@ -1492,14 +1503,9 @@ let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader:
| NotOptional ->
// T --> Nullable<T> widening at callsites
if isOptCallerArg then errorR(Error(FSComp.SR.tcFormalArgumentIsNotOptional(), m))
if isNullableTy g calledArgTy then
NinoFloris marked this conversation as resolved.
Show resolved Hide resolved
if isNullableTy g callerArgTy then
callerArgExpr
else
let calledNonOptTy = destNullableTy g calledArgTy
let _, callerArgExpr2 = AdjustCallerArgExpr tcVal g amap infoReader ad isOutArg calledNonOptTy reflArgInfo callerArgTy m callerArgExpr
let callerArgTy2 = tyOfExpr g callerArgExpr2
MakeNullableExprIfNeeded infoReader calledArgTy callerArgTy2 callerArgExpr2 m
if isNullableTy g calledArgTy then
// AdjustCallerArgExpr later on will deal with the nullable conversion
callerArgExpr
else
failwith "unreachable" // see case above

Expand All @@ -1521,21 +1527,8 @@ let AdjustCallerArgForOptional tcVal tcFieldInit eCallerMemberName (infoReader:
// This should be unreachable but the error will be reported elsewhere
callerArgExpr
else
if isNullableTy g calledArgTy then
dsyme marked this conversation as resolved.
Show resolved Hide resolved
if isNullableTy g callerArgTy then
// CSharpMethod(x=b) when 'x' has nullable type
// CSharpMethod(x=b) when both 'x' and 'b' have nullable type --> CSharpMethod(x=b)
callerArgExpr
else
// CSharpMethod(x=b) when 'x' has nullable type and 'b' does not --> CSharpMethod(x=Nullable(b))
let calledNonOptTy = destNullableTy g calledArgTy
let _, callerArgExpr2 = AdjustCallerArgExpr tcVal g amap infoReader ad isOutArg calledNonOptTy reflArgInfo callerArgTy m callerArgExpr
let callerArgTy2 = tyOfExpr g callerArgExpr2
MakeNullableExprIfNeeded infoReader calledArgTy callerArgTy2 callerArgExpr2 m
else
// CSharpMethod(x=b) --> CSharpMethod(?x=b)
let _, callerArgExpr2 = AdjustCallerArgExpr tcVal g amap infoReader ad isOutArg calledArgTy reflArgInfo callerArgTy m callerArgExpr
callerArgExpr2
// AdjustCallerArgExpr later on will deal with any nullable conversion
callerArgExpr

| CalleeSide ->
if isOptCallerArg then
Expand Down
2 changes: 1 addition & 1 deletion src/Compiler/Checking/MethodCalls.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -119,7 +119,7 @@ type CallerArgs<'T> =
/// has been used in F# code
[<RequireQualifiedAccess>]
type TypeDirectedConversionUsed =
| Yes of (DisplayEnv -> exn)
| Yes of (DisplayEnv -> exn) * isTwoStepConversion: bool
| No

static member Combine: TypeDirectedConversionUsed -> TypeDirectedConversionUsed -> TypeDirectedConversionUsed
Expand Down
Loading