Skip to content
Closed
7 changes: 4 additions & 3 deletions src/Compiler/Checking/CheckExpressions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -773,7 +773,8 @@ let UnifyOverallType cenv (env: TcEnv) m overallTy actualTy =
()
else
// try adhoc type-directed conversions
let reqdTy2, usesTDC, eqn = AdjustRequiredTypeForTypeDirectedConversions cenv.infoReader env.eAccessRights isMethodArg false reqdTy actualTy m
let (TypeAdjustmentInfo(reqdTy2, usesTDC, eqn)) =
AdjustRequiredTypeForTypeDirectedConversions cenv.infoReader env.eAccessRights isMethodArg false reqdTy actualTy m

match eqn with
| Some (ty1, ty2, msg) ->
Expand All @@ -782,8 +783,8 @@ let UnifyOverallType cenv (env: TcEnv) m overallTy actualTy =
| None -> ()

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

if AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m reqdTy2 actualTy then
let reqdTyText, actualTyText, _cxs = NicePrint.minimalStringsOfTwoTypes env.DisplayEnv reqdTy actualTy
Expand Down
79 changes: 52 additions & 27 deletions src/Compiler/Checking/ConstraintSolver.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2412,15 +2412,15 @@ and CanMemberSigsMatchUpToCheck
alwaysCheckReturn
// Used to equate the formal method instantiation with the actual method instantiation
// for a generic method, and the return types
(unifyTypes: TType -> TType -> OperationResult<TypeDirectedConversionUsed>)
(unifyTypes: TType -> TType -> OperationResult<ConversionInfo>)
// Used to compare the "obj" type
(subsumeTypes: TType -> TType -> OperationResult<TypeDirectedConversionUsed>)
(subsumeTypes: TType -> TType -> OperationResult<ConversionInfo>)
// Used to convert the "return" for MustConvertTo
(subsumeOrConvertTypes: bool -> TType -> TType -> OperationResult<TypeDirectedConversionUsed>)
(subsumeOrConvertTypes: bool -> TType -> TType -> OperationResult<ConversionInfo>)
// Used to convert the arguments
(subsumeOrConvertArg: CalledArg -> CallerArg<_> -> OperationResult<TypeDirectedConversionUsed>)
(subsumeOrConvertArg: CalledArg -> CallerArg<_> -> OperationResult<ConversionInfo>)
(reqdRetTyOpt: OverallTy option)
(calledMeth: CalledMeth<_>): OperationResult<TypeDirectedConversionUsed> =
(calledMeth: CalledMeth<_>): OperationResult<ConversionInfo> =
trackErrors {
let g = csenv.g
let amap = csenv.amap
Expand Down Expand Up @@ -2478,10 +2478,10 @@ and CanMemberSigsMatchUpToCheck
)


| _ -> ResultD TypeDirectedConversionUsed.No
| _ -> ResultD ConversionInfo.NoneOrOther
else
ResultD TypeDirectedConversionUsed.No
| _ -> ResultD TypeDirectedConversionUsed.No
ResultD ConversionInfo.NoneOrOther
| _ -> ResultD ConversionInfo.NoneOrOther

let! usesTDC5 =
calledMeth.ArgSets |> MapCombineTDCD (fun argSet ->
Expand Down Expand Up @@ -2516,16 +2516,16 @@ and CanMemberSigsMatchUpToCheck
let! usesTDC7 =
match reqdRetTyOpt with
| Some _ when ( (* minfo.IsConstructor || *) not alwaysCheckReturn && isNil unnamedCalledOutArgs) ->
ResultD TypeDirectedConversionUsed.No
ResultD ConversionInfo.NoneOrOther
| Some (MustConvertTo(isMethodArg, reqdTy)) when g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions ->
let methodRetTy = calledMeth.CalledReturnTypeAfterOutArgTupling
subsumeOrConvertTypes isMethodArg reqdTy methodRetTy
| Some reqdRetTy ->
let methodRetTy = calledMeth.CalledReturnTypeAfterOutArgTupling
unifyTypes reqdRetTy.Commit methodRetTy
| _ ->
ResultD TypeDirectedConversionUsed.No
return Array.reduce TypeDirectedConversionUsed.Combine [| usesTDC1; usesTDC2; usesTDC3; usesTDC4; usesTDC5; usesTDC6; usesTDC7 |]
ResultD ConversionInfo.NoneOrOther
return Array.reduce ConversionInfo.Combine [| usesTDC1; usesTDC2; usesTDC3; usesTDC4; usesTDC5; usesTDC6; usesTDC7 |]
}

// Wrap an ErrorsFromAddingSubsumptionConstraint error around any failure
Expand Down Expand Up @@ -2585,15 +2585,20 @@ and ArgsMustSubsumeOrConvert

let g = csenv.g
let m = callerArg.Range
let calledArgTy, usesTDC, eqn = AdjustCalledArgType csenv.InfoReader ad isConstraint enforceNullableOptionalsKnownTypes calledArg callerArg

let (TypeAdjustmentInfo(calledArgTy, usesTDC, eqn)) =
AdjustCalledArgType csenv.InfoReader ad isConstraint enforceNullableOptionalsKnownTypes calledArg callerArg

match eqn with
| Some (ty1, ty2, msg) ->
do! SolveTypeEqualsTypeWithReport csenv ndeep m trace cxsln ty1 ty2
msg csenv.DisplayEnv
| None -> ()

match usesTDC with
| TypeDirectedConversionUsed.Yes warn -> do! WarnD(warn csenv.DisplayEnv)
| TypeDirectedConversionUsed.No -> ()
| ConversionInfo.TypeDirected warn -> do! WarnD(warn csenv.DisplayEnv)
| _ -> ()

do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln calledArgTy callerArg.CallerArgumentType
if calledArg.IsParamArray && isArray1DTy g calledArgTy && not (isArray1DTy g callerArg.CallerArgumentType) then
return! ErrorD(Error(FSComp.SR.csMethodExpectsParams(), m))
Expand All @@ -2616,59 +2621,74 @@ and ArgsMustSubsumeOrConvertWithContextualReport
trackErrors {
let callerArgTy = callerArg.CallerArgumentType
let m = callerArg.Range
let calledArgTy, usesTDC, eqn = AdjustCalledArgType csenv.InfoReader ad isConstraint true calledArg callerArg

let (TypeAdjustmentInfo(calledArgTy, usesTDC, eqn)) =
AdjustCalledArgType csenv.InfoReader ad isConstraint true calledArg callerArg

match eqn with
| Some (ty1, ty2, msg) ->
do! SolveTypeEqualsType csenv ndeep m trace cxsln ty1 ty2
msg csenv.DisplayEnv
| None -> ()

match usesTDC with
| TypeDirectedConversionUsed.Yes warn -> do! WarnD(warn csenv.DisplayEnv)
| TypeDirectedConversionUsed.No -> ()
| ConversionInfo.TypeDirected warn -> do! WarnD(warn csenv.DisplayEnv)
| _ -> ()

do! SolveTypeSubsumesTypeWithWrappedContextualReport csenv ndeep m trace cxsln calledArgTy callerArgTy (fun e -> ArgDoesNotMatchError(e :?> _, calledMeth, calledArg, callerArg))

return usesTDC
}

and TypesEquiv csenv ndeep trace cxsln ty1 ty2 =
trackErrors {
do! SolveTypeEqualsTypeWithReport csenv ndeep csenv.m trace cxsln ty1 ty2
return TypeDirectedConversionUsed.No
return ConversionInfo.NoneOrOther
}

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

and ReturnTypesMustSubsumeOrConvert (csenv: ConstraintSolverEnv) ad ndeep trace cxsln isConstraint m isMethodArg reqdTy actualTy =
trackErrors {
let reqdTy, usesTDC, eqn = AdjustRequiredTypeForTypeDirectedConversions csenv.InfoReader ad isMethodArg isConstraint reqdTy actualTy m
let (TypeAdjustmentInfo(reqdTy, usesTDC, eqn)) =
AdjustRequiredTypeForTypeDirectedConversions csenv.InfoReader ad isMethodArg isConstraint reqdTy actualTy m

match eqn with
| Some (ty1, ty2, msg) ->
do! SolveTypeEqualsType csenv ndeep m trace cxsln ty1 ty2
msg csenv.DisplayEnv
| None -> ()

match usesTDC with
| TypeDirectedConversionUsed.Yes warn -> do! WarnD(warn csenv.DisplayEnv)
| TypeDirectedConversionUsed.No -> ()
| ConversionInfo.TypeDirected warn -> do! WarnD(warn csenv.DisplayEnv)
| _ -> ()

do! SolveTypeSubsumesTypeWithReport csenv ndeep m trace cxsln reqdTy actualTy

return usesTDC
}

and ArgsEquivOrConvert (csenv: ConstraintSolverEnv) ad ndeep trace cxsln isConstraint calledArg (callerArg: CallerArg<_>) =
trackErrors {
let callerArgTy = callerArg.CallerArgumentType
let m = callerArg.Range
let calledArgTy, usesTDC, eqn = AdjustCalledArgType csenv.InfoReader ad isConstraint true calledArg callerArg
let (TypeAdjustmentInfo(calledArgTy, usesTDC, eqn)) =
AdjustCalledArgType csenv.InfoReader ad isConstraint true calledArg callerArg

match eqn with
| Some (ty1, ty2, msg) ->
do! SolveTypeEqualsType csenv ndeep m trace cxsln ty1 ty2
msg csenv.DisplayEnv
| None -> ()

match usesTDC with
| TypeDirectedConversionUsed.Yes warn -> do! WarnD(warn csenv.DisplayEnv)
| TypeDirectedConversionUsed.No -> ()
| ConversionInfo.TypeDirected warn -> do! WarnD(warn csenv.DisplayEnv)
| _ -> ()

if not (typeEquiv csenv.g calledArgTy callerArgTy) then
return! ErrorD(Error(FSComp.SR.csArgumentTypesDoNotMatch(), m))
else
Expand Down Expand Up @@ -2716,7 +2736,8 @@ and ReportNoCandidatesError (csenv: ConstraintSolverEnv) (nUnnamedCallerArgs, nN
ErrorWithSuggestions((msgNum, FSComp.SR.csCtorHasNoArgumentOrReturnProperty(methodName, id.idText, msgText)), id.idRange, id.idText, suggestFields)
else
Error((msgNum, FSComp.SR.csMemberHasNoArgumentOrReturnProperty(methodName, id.idText, msgText)), id.idRange)
| [] -> Error((msgNum, msgText), m)
| [] ->
Error((msgNum, msgText), m)

// One method, incorrect number of arguments provided by the user
| _, _, ([], [cmeth]), _, _ when not cmeth.HasCorrectArity ->
Expand Down Expand Up @@ -3074,7 +3095,7 @@ and GetMostApplicableOverload csenv ndeep candidates applicableMeths calledMethG
let otherWarnCount = List.length otherWarnings

// 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)
let c = compare (match usesTDC1 with ConversionInfo.TypeDirected _ -> 0 | _ -> 1) (match usesTDC2 with ConversionInfo.TypeDirected _ -> 0 | _ -> 1)
if c <> 0 then c else

// Prefer methods that don't give "this code is less generic" warnings
Expand Down Expand Up @@ -3177,6 +3198,10 @@ and GetMostApplicableOverload csenv ndeep candidates applicableMeths calledMethG
0
if c <> 0 then c else

// Prefer methods that don't use either nullable adjustment or type-directed conversion
let c = compare (match usesTDC1 with ConversionInfo.NoneOrOther -> 1 | _ -> 0) (match usesTDC2 with ConversionInfo.NoneOrOther -> 1 | _ -> 0)
if c <> 0 then c else

0

let bestMethods =
Expand Down
Loading