diff --git a/.fantomasignore b/.fantomasignore index a4802164d9b..20249273f54 100644 --- a/.fantomasignore +++ b/.fantomasignore @@ -117,6 +117,9 @@ src/Compiler/Facilities/AsyncMemoize.fsi src/Compiler/Facilities/AsyncMemoize.fs src/Compiler/AbstractIL/il.fs +src/Compiler/Driver/GraphChecking/Graph.fsi +src/Compiler/Driver/GraphChecking/Graph.fs + # Fantomas limitations on implementation files (to investigate) src/Compiler/AbstractIL/ilwrite.fs diff --git a/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md b/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md index c7d7b11d770..688dd4bc702 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md +++ b/docs/release-notes/.FSharp.Compiler.Service/9.0.200.md @@ -1,11 +1,11 @@ ### Fixed +* Fix false negatives for passing null to "obj" arguments. Only "obj | null" can now subsume any type ([PR #17757](https://github.com/dotnet/fsharp/pull/17757)) * Fix internal error when calling 'AddSingleton' and other overloads only differing in generic arity ([PR #17804](https://github.com/dotnet/fsharp/pull/17804)) * Fix extension methods support for non-reference system assemblies ([PR #17799](https://github.com/dotnet/fsharp/pull/17799)) * Ensure `frameworkTcImportsCache` mutations are thread-safe. ([PR #17795](https://github.com/dotnet/fsharp/pull/17795)) * Fix concurrency issue in `ILPreTypeDefImpl` ([PR #17812](https://github.com/dotnet/fsharp/pull/17812)) - ### Added diff --git a/src/Compiler/AbstractIL/ilreflect.fs b/src/Compiler/AbstractIL/ilreflect.fs index 2a65eb8679b..5a52ddc017a 100644 --- a/src/Compiler/AbstractIL/ilreflect.fs +++ b/src/Compiler/AbstractIL/ilreflect.fs @@ -277,7 +277,7 @@ type TypeBuilder with match m with | null -> raise (MissingMethodException nm) - | m -> m.Invoke(null, args) + | m -> m.Invoke(null, (args: obj array)) member typB.SetCustomAttributeAndLog(cinfo, bytes) = if logRefEmitCalls then diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index a91ace98d4a..8ef659ac20e 100644 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -466,9 +466,9 @@ let MethInfoIsUnseen g (m: range) (ty: TType) minfo = let isUnseenByHidingAttribute () = #if !NO_TYPEPROVIDERS - not (isObjTy g ty) && + not (isObjTyAnyNullness g ty) && isAppTy g ty && - isObjTy g minfo.ApparentEnclosingType && + isObjTyAnyNullness g minfo.ApparentEnclosingType && let tcref = tcrefOfAppTy g ty match tcref.TypeReprInfo with | TProvidedTypeRepr info -> diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index f9ed37fe9ca..6c79c33be97 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -1225,164 +1225,165 @@ and SolveTypeEqualsType (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr TransactMemberConstraintSolution traitInfo trace traitSln | _ -> () - if ty1 === ty2 then CompleteD else + if ty1 === ty2 then + CompleteD + else + let canShortcut = not trace.HasTrace + let sty1 = stripTyEqnsA csenv.g canShortcut ty1 + let sty2 = stripTyEqnsA csenv.g canShortcut ty2 + + let csenv = + match ty1 with + | TType.TType_var(r,_) when r.typar_flags.IsSupportsNullFlex -> + { csenv with IsSupportsNullFlex = true} + | _ -> csenv + + match sty1, sty2 with + // type vars inside forall-types may be alpha-equivalent + | TType_var (tp1, nullness1), TType_var (tp2, nullness2) when typarEq tp1 tp2 || (match aenv.EquivTypars.TryFind tp1 with | Some tpTy1 when typeEquiv g tpTy1 ty2 -> true | _ -> false) -> + SolveNullnessEquiv csenv m2 trace ty1 ty2 nullness1 nullness2 + + | TType_var (tp1, nullness1), TType_var (tp2, nullness2) when PreferUnifyTypar tp1 tp2 -> + match nullness1.TryEvaluate(), nullness2.TryEvaluate() with + // Unifying 'T1? and 'T2? + | ValueSome NullnessInfo.WithNull, ValueSome NullnessInfo.WithNull -> + SolveTyparEqualsType csenv ndeep m2 trace sty1 (TType_var (tp2, g.knownWithoutNull)) + | ValueSome NullnessInfo.WithNull, ValueSome NullnessInfo.WithoutNull -> + let tpNew = NewCompGenTypar(TyparKind.Type, TyparRigidity.Flexible, TyparStaticReq.None, TyparDynamicReq.No, false) + trackErrors { + do! SolveTypeEqualsType csenv ndeep m2 trace cxsln sty2 (TType_var(tpNew, g.knownWithNull)) + do! SolveTypeEqualsType csenv ndeep m2 trace cxsln (TType_var(tpNew, g.knownWithoutNull)) sty1 + } + //// Unifying 'T1 % and 'T2 % + //| ValueSome NullnessInfo.AmbivalentToNull, ValueSome NullnessInfo.AmbivalentToNull -> + // SolveTyparEqualsType csenv ndeep m2 trace sty1 (TType_var (tp2, g.knownWithoutNull)) + | _ -> + trackErrors { + do! SolveTyparEqualsType csenv ndeep m2 trace sty1 ty2 + let nullnessAfterSolution1 = combineNullness (nullnessOfTy g sty1) nullness1 + do! SolveNullnessEquiv csenv m2 trace ty1 ty2 nullnessAfterSolution1 nullness2 + } - let canShortcut = not trace.HasTrace - let sty1 = stripTyEqnsA csenv.g canShortcut ty1 - let sty2 = stripTyEqnsA csenv.g canShortcut ty2 - let csenv = - match ty1 with - | TType.TType_var(r,_) when r.typar_flags.IsSupportsNullFlex -> - { csenv with IsSupportsNullFlex = true} - | _ -> csenv - - match sty1, sty2 with - // type vars inside forall-types may be alpha-equivalent - | TType_var (tp1, nullness1), TType_var (tp2, nullness2) when typarEq tp1 tp2 || (match aenv.EquivTypars.TryFind tp1 with | Some tpTy1 when typeEquiv g tpTy1 ty2 -> true | _ -> false) -> - SolveNullnessEquiv csenv m2 trace ty1 ty2 nullness1 nullness2 - - | TType_var (tp1, nullness1), TType_var (tp2, nullness2) when PreferUnifyTypar tp1 tp2 -> - match nullness1.TryEvaluate(), nullness2.TryEvaluate() with - // Unifying 'T1? and 'T2? - | ValueSome NullnessInfo.WithNull, ValueSome NullnessInfo.WithNull -> - SolveTyparEqualsType csenv ndeep m2 trace sty1 (TType_var (tp2, g.knownWithoutNull)) - | ValueSome NullnessInfo.WithNull, ValueSome NullnessInfo.WithoutNull -> - let tpNew = NewCompGenTypar(TyparKind.Type, TyparRigidity.Flexible, TyparStaticReq.None, TyparDynamicReq.No, false) - trackErrors { - do! SolveTypeEqualsType csenv ndeep m2 trace cxsln sty2 (TType_var(tpNew, g.knownWithNull)) - do! SolveTypeEqualsType csenv ndeep m2 trace cxsln (TType_var(tpNew, g.knownWithoutNull)) sty1 - } - //// Unifying 'T1 % and 'T2 % - //| ValueSome NullnessInfo.AmbivalentToNull, ValueSome NullnessInfo.AmbivalentToNull -> - // SolveTyparEqualsType csenv ndeep m2 trace sty1 (TType_var (tp2, g.knownWithoutNull)) - | _ -> - trackErrors { - do! SolveTyparEqualsType csenv ndeep m2 trace sty1 ty2 - let nullnessAfterSolution1 = combineNullness (nullnessOfTy g sty1) nullness1 - do! SolveNullnessEquiv csenv m2 trace ty1 ty2 nullnessAfterSolution1 nullness2 - } + | TType_var (tp1, nullness1), TType_var (tp2, nullness2) when not csenv.MatchingOnly && PreferUnifyTypar tp2 tp1 -> + match nullness1.TryEvaluate(), nullness2.TryEvaluate() with + // Unifying 'T1? and 'T2? + | ValueSome NullnessInfo.WithNull, ValueSome NullnessInfo.WithNull -> + SolveTyparEqualsType csenv ndeep m2 trace sty2 (TType_var (tp1, g.knownWithoutNull)) + | ValueSome NullnessInfo.WithNull, ValueSome NullnessInfo.WithoutNull -> + let tpNew = NewCompGenTypar(TyparKind.Type, TyparRigidity.Flexible, TyparStaticReq.None, TyparDynamicReq.No, false) + trackErrors { + do! SolveTypeEqualsType csenv ndeep m2 trace cxsln sty2 (TType_var(tpNew, g.knownWithNull)) + do! SolveTypeEqualsType csenv ndeep m2 trace cxsln (TType_var(tpNew, g.knownWithoutNull)) sty1 + } + //// Unifying 'T1 % and 'T2 % + //| ValueSome NullnessInfo.AmbivalentToNull, ValueSome NullnessInfo.AmbivalentToNull -> + // SolveTyparEqualsType csenv ndeep m2 trace sty2 (TType_var (tp1, g.knownWithoutNull)) + | _ -> + // Unifying 'T1 ? and 'T2 % + // Unifying 'T1 % and 'T2 ? + trackErrors { + do! SolveTyparEqualsType csenv ndeep m2 trace sty2 ty1 + let nullnessAfterSolution2 = combineNullness (nullnessOfTy g sty2) nullness2 + do! SolveNullnessEquiv csenv m2 trace ty1 ty2 nullness1 nullnessAfterSolution2 + } + | TType_var (tp1, nullness1), _ when not (IsRigid csenv tp1) -> + match nullness1.TryEvaluate(), (nullnessOfTy g sty2).TryEvaluate() with + // Unifying 'T1? and 'T2? + | ValueSome NullnessInfo.WithNull, ValueSome NullnessInfo.WithNull -> + SolveTyparEqualsType csenv ndeep m2 trace sty1 (replaceNullnessOfTy g.knownWithoutNull sty2) + | ValueSome NullnessInfo.WithoutNull, ValueSome NullnessInfo.WithoutNull when + csenv.IsSupportsNullFlex && + isAppTy g sty2 && + tp1.Constraints |> List.exists (function TyparConstraint.SupportsNull _ -> true | _ -> false) -> + let tpNew = NewCompGenTypar(TyparKind.Type, TyparRigidity.Flexible, TyparStaticReq.None, TyparDynamicReq.No, false) + trackErrors { + do! SolveTypeEqualsType csenv ndeep m2 trace cxsln (TType_var(tpNew, g.knownWithoutNull)) sty2 + do! SolveTypeEqualsType csenv ndeep m2 trace cxsln ty1 (TType_var(tpNew, g.knownWithNull)) + } + // Unifying 'T1 % and 'T2 % + //| ValueSome NullnessInfo.AmbivalentToNull, ValueSome NullnessInfo.AmbivalentToNull -> + // SolveTyparEqualsType csenv ndeep m2 trace sty1 (replaceNullnessOfTy g.knownWithoutNull sty2) + | _ -> + trackErrors { + do! SolveTyparEqualsType csenv ndeep m2 trace sty1 ty2 + let nullnessAfterSolution1 = combineNullness (nullnessOfTy g sty1) nullness1 + do! SolveNullnessEquiv csenv m2 trace ty1 ty2 nullnessAfterSolution1 (nullnessOfTy g sty2) + } - | TType_var (tp1, nullness1), TType_var (tp2, nullness2) when not csenv.MatchingOnly && PreferUnifyTypar tp2 tp1 -> - match nullness1.TryEvaluate(), nullness2.TryEvaluate() with - // Unifying 'T1? and 'T2? - | ValueSome NullnessInfo.WithNull, ValueSome NullnessInfo.WithNull -> - SolveTyparEqualsType csenv ndeep m2 trace sty2 (TType_var (tp1, g.knownWithoutNull)) - | ValueSome NullnessInfo.WithNull, ValueSome NullnessInfo.WithoutNull -> - let tpNew = NewCompGenTypar(TyparKind.Type, TyparRigidity.Flexible, TyparStaticReq.None, TyparDynamicReq.No, false) - trackErrors { - do! SolveTypeEqualsType csenv ndeep m2 trace cxsln sty2 (TType_var(tpNew, g.knownWithNull)) - do! SolveTypeEqualsType csenv ndeep m2 trace cxsln (TType_var(tpNew, g.knownWithoutNull)) sty1 - } - //// Unifying 'T1 % and 'T2 % - //| ValueSome NullnessInfo.AmbivalentToNull, ValueSome NullnessInfo.AmbivalentToNull -> - // SolveTyparEqualsType csenv ndeep m2 trace sty2 (TType_var (tp1, g.knownWithoutNull)) - | _ -> - // Unifying 'T1 ? and 'T2 % - // Unifying 'T1 % and 'T2 ? + | _, TType_var (tp2, nullness2) when not csenv.MatchingOnly && not (IsRigid csenv tp2) -> + match (nullnessOfTy g sty1).TryEvaluate(), nullness2.TryEvaluate() with + // Unifying 'T1? and 'T2? + | ValueSome NullnessInfo.WithNull, ValueSome NullnessInfo.WithNull -> + SolveTyparEqualsType csenv ndeep m2 trace sty2 (replaceNullnessOfTy g.knownWithoutNull sty1) + // Unifying 'T1 % and 'T2 % + //| ValueSome NullnessInfo.AmbivalentToNull, ValueSome NullnessInfo.AmbivalentToNull -> + // SolveTyparEqualsType csenv ndeep m2 trace sty2 (replaceNullnessOfTy g.knownWithoutNull sty1) + | _ -> + trackErrors { + do! SolveTyparEqualsType csenv ndeep m2 trace sty2 ty1 + let nullnessAfterSolution2 = combineNullness (nullnessOfTy g sty2) nullness2 + do! SolveNullnessEquiv csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) nullnessAfterSolution2 + } + + // Catch float<_>=float<1>, float32<_>=float32<1> and decimal<_>=decimal<1> + | (_, TType_app (tc2, [ms2], _)) when (tc2.IsMeasureableReprTycon && typeEquiv csenv.g sty1 (reduceTyconRefMeasureableOrProvided csenv.g tc2 [ms2])) -> trackErrors { - do! SolveTyparEqualsType csenv ndeep m2 trace sty2 ty1 - let nullnessAfterSolution2 = combineNullness (nullnessOfTy g sty2) nullness2 - do! SolveNullnessEquiv csenv m2 trace ty1 ty2 nullness1 nullnessAfterSolution2 + do! SolveTypeEqualsType csenv ndeep m2 trace None (TType_measure Measure.One) ms2 + do! SolveNullnessEquiv csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2) } - | TType_var (tp1, nullness1), _ when not (IsRigid csenv tp1) -> - match nullness1.TryEvaluate(), (nullnessOfTy g sty2).TryEvaluate() with - // Unifying 'T1? and 'T2? - | ValueSome NullnessInfo.WithNull, ValueSome NullnessInfo.WithNull -> - SolveTyparEqualsType csenv ndeep m2 trace sty1 (replaceNullnessOfTy g.knownWithoutNull sty2) - | ValueSome NullnessInfo.WithoutNull, ValueSome NullnessInfo.WithoutNull when - csenv.IsSupportsNullFlex && - isAppTy g sty2 && - tp1.Constraints |> List.exists (function TyparConstraint.SupportsNull _ -> true | _ -> false) -> - let tpNew = NewCompGenTypar(TyparKind.Type, TyparRigidity.Flexible, TyparStaticReq.None, TyparDynamicReq.No, false) - trackErrors { - do! SolveTypeEqualsType csenv ndeep m2 trace cxsln (TType_var(tpNew, g.knownWithoutNull)) sty2 - do! SolveTypeEqualsType csenv ndeep m2 trace cxsln ty1 (TType_var(tpNew, g.knownWithNull)) - } - // Unifying 'T1 % and 'T2 % - //| ValueSome NullnessInfo.AmbivalentToNull, ValueSome NullnessInfo.AmbivalentToNull -> - // SolveTyparEqualsType csenv ndeep m2 trace sty1 (replaceNullnessOfTy g.knownWithoutNull sty2) - | _ -> + | (TType_app (tc1, [ms1], _), _) when (tc1.IsMeasureableReprTycon && typeEquiv csenv.g sty2 (reduceTyconRefMeasureableOrProvided csenv.g tc1 [ms1])) -> trackErrors { - do! SolveTyparEqualsType csenv ndeep m2 trace sty1 ty2 - let nullnessAfterSolution1 = combineNullness (nullnessOfTy g sty1) nullness1 - do! SolveNullnessEquiv csenv m2 trace ty1 ty2 nullnessAfterSolution1 (nullnessOfTy g sty2) + do! SolveTypeEqualsType csenv ndeep m2 trace None ms1 (TType_measure Measure.One) + do! SolveNullnessEquiv csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2) } - | _, TType_var (tp2, nullness2) when not csenv.MatchingOnly && not (IsRigid csenv tp2) -> - match (nullnessOfTy g sty1).TryEvaluate(), nullness2.TryEvaluate() with - // Unifying 'T1? and 'T2? - | ValueSome NullnessInfo.WithNull, ValueSome NullnessInfo.WithNull -> - SolveTyparEqualsType csenv ndeep m2 trace sty2 (replaceNullnessOfTy g.knownWithoutNull sty1) - // Unifying 'T1 % and 'T2 % - //| ValueSome NullnessInfo.AmbivalentToNull, ValueSome NullnessInfo.AmbivalentToNull -> - // SolveTyparEqualsType csenv ndeep m2 trace sty2 (replaceNullnessOfTy g.knownWithoutNull sty1) - | _ -> + | TType_app (tc1, l1, _), TType_app (tc2, l2, _) when tyconRefEq g tc1 tc2 -> trackErrors { - do! SolveTyparEqualsType csenv ndeep m2 trace sty2 ty1 - let nullnessAfterSolution2 = combineNullness (nullnessOfTy g sty2) nullness2 - do! SolveNullnessEquiv csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) nullnessAfterSolution2 + do! SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2 + do! SolveNullnessEquiv csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2) } + | TType_app _, TType_app _ -> + localAbortD - // Catch float<_>=float<1>, float32<_>=float32<1> and decimal<_>=decimal<1> - | (_, TType_app (tc2, [ms2], _)) when (tc2.IsMeasureableReprTycon && typeEquiv csenv.g sty1 (reduceTyconRefMeasureableOrProvided csenv.g tc2 [ms2])) -> - trackErrors { - do! SolveTypeEqualsType csenv ndeep m2 trace None (TType_measure Measure.One) ms2 - do! SolveNullnessEquiv csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2) - } - - | (TType_app (tc1, [ms1], _), _) when (tc1.IsMeasureableReprTycon && typeEquiv csenv.g sty2 (reduceTyconRefMeasureableOrProvided csenv.g tc1 [ms1])) -> - trackErrors { - do! SolveTypeEqualsType csenv ndeep m2 trace None ms1 (TType_measure Measure.One) - do! SolveNullnessEquiv csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2) - } - - | TType_app (tc1, l1, _), TType_app (tc2, l2, _) when tyconRefEq g tc1 tc2 -> - trackErrors { - do! SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2 - do! SolveNullnessEquiv csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2) - } - | TType_app _, TType_app _ -> - localAbortD - - | TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2) -> - if evalTupInfoIsStruct tupInfo1 <> evalTupInfoIsStruct tupInfo2 then - ErrorD (ConstraintSolverError(FSComp.SR.tcTupleStructMismatch(), csenv.m, m2)) - else - SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2 + | TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2) -> + 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) -> - trackErrors { - do! SolveAnonInfoEqualsAnonInfo csenv m2 anonInfo1 anonInfo2 - do! 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, nullness1), TType_fun (domainTy2, rangeTy2, nullness2) -> - trackErrors { - do! SolveFunTypeEqn csenv ndeep m2 trace None domainTy1 domainTy2 rangeTy1 rangeTy2 - do! SolveNullnessEquiv csenv m2 trace ty1 ty2 nullness1 nullness2 - } + | TType_fun (domainTy1, rangeTy1, nullness1), TType_fun (domainTy2, rangeTy2, nullness2) -> + trackErrors { + do! SolveFunTypeEqn csenv ndeep m2 trace None domainTy1 domainTy2 rangeTy1 rangeTy2 + do! SolveNullnessEquiv csenv m2 trace ty1 ty2 nullness1 nullness2 + } - | TType_measure ms1, TType_measure ms2 -> - UnifyMeasures csenv trace ms1 ms2 + | TType_measure ms1, TType_measure ms2 -> + UnifyMeasures csenv trace ms1 ms2 - | TType_forall(tps1, bodyTy1), TType_forall(tps2, bodyTy2) -> - if tps1.Length <> tps2.Length then - localAbortD - else - let aenv = aenv.BindEquivTypars tps1 tps2 - let csenv = {csenv with EquivEnv = aenv } - if not (typarsAEquiv g aenv tps1 tps2) then + | TType_forall(tps1, bodyTy1), TType_forall(tps2, bodyTy2) -> + if tps1.Length <> tps2.Length then localAbortD else - SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace bodyTy1 bodyTy2 + let aenv = aenv.BindEquivTypars tps1 tps2 + let csenv = {csenv with EquivEnv = aenv } + if not (typarsAEquiv g aenv tps1 tps2) then + localAbortD + else + SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace bodyTy1 bodyTy2 - | TType_ucase (uc1, l1), TType_ucase (uc2, l2) when g.unionCaseRefEq uc1 uc2 -> - SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2 + | TType_ucase (uc1, l1), TType_ucase (uc2, l2) when g.unionCaseRefEq uc1 uc2 -> + SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2 - | _ -> localAbortD + | _ -> localAbortD and SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty1 ty2 = SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace None ty1 ty2 @@ -1455,132 +1456,136 @@ and SolveFunTypeEqn csenv ndeep m2 trace cxsln domainTy1 domainTy2 rangeTy1 rang // // "ty2 casts to ty1" // "a value of type ty2 can be used where a value of type ty1 is expected" -and SolveTypeSubsumesType (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTrace) cxsln ty1 ty2 = - // 'a :> obj ---> +and SolveTypeSubsumesType (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTrace) cxsln ty1 ty2 = let ndeep = ndeep + 1 let g = csenv.g - if isObjTy g ty1 then CompleteD else let canShortcut = not trace.HasTrace - let sty1 = stripTyEqnsA csenv.g canShortcut ty1 - let sty2 = stripTyEqnsA csenv.g canShortcut ty2 - let amap = csenv.amap - let aenv = csenv.EquivEnv - let denv = csenv.DisplayEnv + // 'a :> objnull ---> + if isObjNullTy g ty1 then + CompleteD + elif isObjTyAnyNullness g ty1 && not csenv.MatchingOnly && not(isTyparTy g ty2) then + let nullness t = t |> stripTyEqnsA g canShortcut |> nullnessOfTy g + SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 (nullness ty1) (nullness ty2) + else + let sty1 = stripTyEqnsA csenv.g canShortcut ty1 + let sty2 = stripTyEqnsA csenv.g canShortcut ty2 + let amap = csenv.amap + let aenv = csenv.EquivEnv + let denv = csenv.DisplayEnv - match sty1, sty2 with - | TType_var (tp1, nullness1) , _ -> - match aenv.EquivTypars.TryFind tp1 with - | Some tpTy1 -> SolveTypeSubsumesType csenv ndeep m2 trace cxsln tpTy1 ty2 - | _ -> - match sty2 with - | TType_var (r2, nullness2) when typarEq tp1 r2 -> - SolveNullnessEquiv csenv m2 trace ty1 ty2 nullness1 nullness2 - | TType_var (r2, nullness2) when not csenv.MatchingOnly -> + match sty1, sty2 with + | TType_var (tp1, nullness1) , _ -> + match aenv.EquivTypars.TryFind tp1 with + | Some tpTy1 -> SolveTypeSubsumesType csenv ndeep m2 trace cxsln tpTy1 ty2 + | _ -> + match sty2 with + | TType_var (r2, nullness2) when typarEq tp1 r2 -> + SolveNullnessEquiv csenv m2 trace ty1 ty2 nullness1 nullness2 + | TType_var (r2, nullness2) when not csenv.MatchingOnly -> + trackErrors { + do! SolveTyparSubtypeOfType csenv ndeep m2 trace r2 ty1 + let nullnessAfterSolution2 = combineNullness (nullnessOfTy g sty2) nullness2 + do! SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 nullness1 nullnessAfterSolution2 + } + | _ -> SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln ty1 ty2 + + | _, TType_var (r2, nullness2) when not csenv.MatchingOnly -> trackErrors { do! SolveTyparSubtypeOfType csenv ndeep m2 trace r2 ty1 let nullnessAfterSolution2 = combineNullness (nullnessOfTy g sty2) nullness2 - do! SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 nullness1 nullnessAfterSolution2 + do! SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) nullnessAfterSolution2 } - | _ -> SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln ty1 ty2 - - | _, TType_var (r2, nullness2) when not csenv.MatchingOnly -> - trackErrors { - do! SolveTyparSubtypeOfType csenv ndeep m2 trace r2 ty1 - let nullnessAfterSolution2 = combineNullness (nullnessOfTy g sty2) nullness2 - do! SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) nullnessAfterSolution2 - } - - | TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2) -> - 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_fun (domainTy1, rangeTy1, nullness1), TType_fun (domainTy2, rangeTy2, nullness2) -> - // nb. can unify since no variance - trackErrors { - do! SolveFunTypeEqn csenv ndeep m2 trace cxsln domainTy1 domainTy2 rangeTy1 rangeTy2 - do! SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 nullness1 nullness2 - } - | TType_anon (anonInfo1, l1), TType_anon (anonInfo2, l2) -> - trackErrors { - do! SolveAnonInfoEqualsAnonInfo csenv m2 anonInfo1 anonInfo2 - do! SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln l1 l2 - } - | TType_measure ms1, TType_measure ms2 -> - UnifyMeasures csenv trace ms1 ms2 - // Enforce the identities float=float<1>, float32=float32<1> and decimal=decimal<1> - | _, TType_app (tc2, [ms2], _) when tc2.IsMeasureableReprTycon && typeEquiv csenv.g sty1 (reduceTyconRefMeasureableOrProvided csenv.g tc2 [ms2]) -> - trackErrors { - do! SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln ms2 (TType_measure Measure.One) - do! SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2) - } - - | TType_app (tc1, [ms1], _), _ when tc1.IsMeasureableReprTycon && typeEquiv csenv.g sty2 (reduceTyconRefMeasureableOrProvided csenv.g tc1 [ms1]) -> - trackErrors { - do! SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln ms1 (TType_measure Measure.One) - do! SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2) - } + | TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2) -> + 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_fun (domainTy1, rangeTy1, nullness1), TType_fun (domainTy2, rangeTy2, nullness2) -> + // nb. can unify since no variance + trackErrors { + do! SolveFunTypeEqn csenv ndeep m2 trace cxsln domainTy1 domainTy2 rangeTy1 rangeTy2 + do! SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 nullness1 nullness2 + } + | TType_anon (anonInfo1, l1), TType_anon (anonInfo2, l2) -> + trackErrors { + do! SolveAnonInfoEqualsAnonInfo csenv m2 anonInfo1 anonInfo2 + do! SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln l1 l2 + } + | TType_measure ms1, TType_measure ms2 -> + UnifyMeasures csenv trace ms1 ms2 - // Special subsumption rule for byref tags - | TType_app (tc1, l1, _) , TType_app (tc2, l2, _) when tyconRefEq g tc1 tc2 && g.byref2_tcr.CanDeref && tyconRefEq g g.byref2_tcr tc1 -> - match l1, l2 with - | [ h1; tag1 ], [ h2; tag2 ] -> trackErrors { - do! SolveTypeEqualsType csenv ndeep m2 trace None h1 h2 - match stripTyEqnsA csenv.g canShortcut tag1, stripTyEqnsA csenv.g canShortcut tag2 with - | TType_app(tagc1, [], _), TType_app(tagc2, [], _) - when (tyconRefEq g tagc2 g.byrefkind_InOut_tcr && - (tyconRefEq g tagc1 g.byrefkind_In_tcr || tyconRefEq g tagc1 g.byrefkind_Out_tcr) ) -> () - | _ -> return! SolveTypeEqualsType csenv ndeep m2 trace cxsln tag1 tag2 - } - | _ -> SolveTypeEqualsTypeWithContravarianceEqns csenv ndeep m2 trace cxsln l1 l2 tc1.TyparsNoRange - - | TType_app (tc1, l1, _) , TType_app (tc2, l2, _) when tyconRefEq g tc1 tc2 -> - trackErrors { - do! SolveTypeEqualsTypeWithContravarianceEqns csenv ndeep m2 trace cxsln l1 l2 tc1.TyparsNoRange - do! SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2) - } + // Enforce the identities float=float<1>, float32=float32<1> and decimal=decimal<1> + | _, TType_app (tc2, [ms2], _) when tc2.IsMeasureableReprTycon && typeEquiv csenv.g sty1 (reduceTyconRefMeasureableOrProvided csenv.g tc2 [ms2]) -> + trackErrors { + do! SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln ms2 (TType_measure Measure.One) + do! SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2) + } - | TType_ucase (uc1, l1), TType_ucase (uc2, l2) when g.unionCaseRefEq uc1 uc2 -> - SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln l1 l2 + | TType_app (tc1, [ms1], _), _ when tc1.IsMeasureableReprTycon && typeEquiv csenv.g sty2 (reduceTyconRefMeasureableOrProvided csenv.g tc1 [ms1]) -> + trackErrors { + do! SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln ms1 (TType_measure Measure.One) + do! SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2) + } - | _ -> - // By now we know the type is not a variable type + // Special subsumption rule for byref tags + | TType_app (tc1, l1, _) , TType_app (tc2, l2, _) when tyconRefEq g tc1 tc2 && g.byref2_tcr.CanDeref && tyconRefEq g g.byref2_tcr tc1 -> + match l1, l2 with + | [ h1; tag1 ], [ h2; tag2 ] -> trackErrors { + do! SolveTypeEqualsType csenv ndeep m2 trace None h1 h2 + match stripTyEqnsA csenv.g canShortcut tag1, stripTyEqnsA csenv.g canShortcut tag2 with + | TType_app(tagc1, [], _), TType_app(tagc2, [], _) + when (tyconRefEq g tagc2 g.byrefkind_InOut_tcr && + (tyconRefEq g tagc1 g.byrefkind_In_tcr || tyconRefEq g tagc1 g.byrefkind_Out_tcr) ) -> () + | _ -> return! SolveTypeEqualsType csenv ndeep m2 trace cxsln tag1 tag2 + } + | _ -> SolveTypeEqualsTypeWithContravarianceEqns csenv ndeep m2 trace cxsln l1 l2 tc1.TyparsNoRange - // C :> obj ---> - if isObjTy g ty1 then CompleteD else - - let m = csenv.m + | TType_app (tc1, l1, _) , TType_app (tc2, l2, _) when tyconRefEq g tc1 tc2 -> + trackErrors { + do! SolveTypeEqualsTypeWithContravarianceEqns csenv ndeep m2 trace cxsln l1 l2 tc1.TyparsNoRange + do! SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2) + } - // 'a[] :> IList<'b> ---> 'a = 'b - // 'a[] :> ICollection<'b> ---> 'a = 'b - // 'a[] :> IEnumerable<'b> ---> 'a = 'b - // 'a[] :> IReadOnlyList<'b> ---> 'a = 'b - // 'a[] :> IReadOnlyCollection<'b> ---> 'a = 'b - // Note we don't support co-variance on array types nor - // the special .NET conversions for these types - match ty1 with - | AppTy g (tcref1, tinst1) when - isArray1DTy g ty2 && - (tyconRefEq g tcref1 g.tcref_System_Collections_Generic_IList || - tyconRefEq g tcref1 g.tcref_System_Collections_Generic_ICollection || - tyconRefEq g tcref1 g.tcref_System_Collections_Generic_IReadOnlyList || - tyconRefEq g tcref1 g.tcref_System_Collections_Generic_IReadOnlyCollection || - tyconRefEq g tcref1 g.tcref_System_Collections_Generic_IEnumerable) -> - match tinst1 with - | [elemTy1] -> - let elemTy2 = destArrayTy g ty2 - SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln elemTy1 elemTy2 - | _ -> error(InternalError("destArrayTy", m)) + | TType_ucase (uc1, l1), TType_ucase (uc2, l2) when g.unionCaseRefEq uc1 uc2 -> + SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln l1 l2 | _ -> - // D :> Head<_> --> C :> Head<_> for the - // first interface or super-class C supported by D which - // may feasibly convert to Head. - match FindUniqueFeasibleSupertype g amap m ty1 ty2 with - | None -> ErrorD(ConstraintSolverTypesNotInSubsumptionRelation(denv, ty1, ty2, m, m2)) - | Some t -> SolveTypeSubsumesType csenv ndeep m2 trace cxsln ty1 t + // By now we know the type is not a variable type + // C :> obj ---> + if isObjNullTy g ty1 then + CompleteD + else + let m = csenv.m + // 'a[] :> IList<'b> ---> 'a = 'b + // 'a[] :> ICollection<'b> ---> 'a = 'b + // 'a[] :> IEnumerable<'b> ---> 'a = 'b + // 'a[] :> IReadOnlyList<'b> ---> 'a = 'b + // 'a[] :> IReadOnlyCollection<'b> ---> 'a = 'b + // Note we don't support co-variance on array types nor + // the special .NET conversions for these types + match ty1 with + | AppTy g (tcref1, tinst1) when + isArray1DTy g ty2 && + (tyconRefEq g tcref1 g.tcref_System_Collections_Generic_IList || + tyconRefEq g tcref1 g.tcref_System_Collections_Generic_ICollection || + tyconRefEq g tcref1 g.tcref_System_Collections_Generic_IReadOnlyList || + tyconRefEq g tcref1 g.tcref_System_Collections_Generic_IReadOnlyCollection || + tyconRefEq g tcref1 g.tcref_System_Collections_Generic_IEnumerable) -> + match tinst1 with + | [elemTy1] -> + let elemTy2 = destArrayTy g ty2 + SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln elemTy1 elemTy2 + | _ -> error(InternalError("destArrayTy", m)) + + | _ -> + // D :> Head<_> --> C :> Head<_> for the + // first interface or super-class C supported by D which + // may feasibly convert to Head. + match FindUniqueFeasibleSupertype g amap m ty1 ty2 with + | None -> ErrorD(ConstraintSolverTypesNotInSubsumptionRelation(denv, ty1, ty2, m, m2)) + | Some t -> SolveTypeSubsumesType csenv ndeep m2 trace cxsln ty1 t and SolveTypeSubsumesTypeKeepAbbrevs csenv ndeep m2 trace cxsln ty1 ty2 = let denv = csenv.DisplayEnv @@ -1595,15 +1600,22 @@ and SolveTypeSubsumesTypeKeepAbbrevs csenv ndeep m2 trace cxsln ty1 ty2 = and SolveTyparSubtypeOfType (csenv: ConstraintSolverEnv) ndeep m2 trace tp ty1 = let g = csenv.g - if isObjTy g ty1 then CompleteD - elif typeEquiv g ty1 (mkTyparTy tp) then CompleteD + if isObjNullTy g ty1 then + CompleteD + elif isObjTyAnyNullness g ty1 then + AddConstraint csenv ndeep m2 trace tp (TyparConstraint.NotSupportsNull csenv.m) + elif typeEquiv g ty1 (mkTyparTy tp) then + CompleteD elif isSealedTy g ty1 then SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace (mkTyparTy tp) ty1 else AddConstraint csenv ndeep m2 trace tp (TyparConstraint.CoercesTo(ty1, csenv.m)) and DepthCheck ndeep m = - if ndeep > 300 then error(Error(FSComp.SR.csTypeInferenceMaxDepth(), m)) else CompleteD + if ndeep > 300 then + error(Error(FSComp.SR.csTypeInferenceMaxDepth(), m)) + else + CompleteD // If this is a type that's parameterized on a unit-of-measure (expected to be numeric), unify its measure with 1 and SolveDimensionlessNumericType (csenv: ConstraintSolverEnv) ndeep m2 trace ty = @@ -1625,434 +1637,435 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload trackErrors { let (TTrait(supportTys, nm, memFlags, traitObjAndArgTys, retTy, source, sln)) = traitInfo // Do not re-solve if already solved - if sln.Value.IsSome then return true else - - let g = csenv.g - let m = csenv.m - let amap = csenv.amap - let aenv = csenv.EquivEnv - let denv = csenv.DisplayEnv + if sln.Value.IsSome then + return true + else + let g = csenv.g + let m = csenv.m + let amap = csenv.amap + let aenv = csenv.EquivEnv + let denv = csenv.DisplayEnv - let ndeep = ndeep + 1 - do! DepthCheck ndeep m + let ndeep = ndeep + 1 + do! DepthCheck ndeep m - // Remove duplicates from the set of types in the support - let supportTys = ListSet.setify (typeAEquiv g aenv) supportTys + // Remove duplicates from the set of types in the support + let supportTys = ListSet.setify (typeAEquiv g aenv) supportTys - // Rebuild the trait info after removing duplicates - let traitInfo = traitInfo.WithSupportTypes supportTys - let retTy = GetFSharpViewOfReturnType g retTy + // Rebuild the trait info after removing duplicates + let traitInfo = traitInfo.WithSupportTypes supportTys + let retTy = GetFSharpViewOfReturnType g retTy - // Assert the object type if the constraint is for an instance member - if memFlags.IsInstance then - match supportTys, traitObjAndArgTys with - | [ty], h :: _ -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace h ty - | _ -> do! ErrorD (ConstraintSolverError(FSComp.SR.csExpectedArguments(), m, m2)) + // Assert the object type if the constraint is for an instance member + if memFlags.IsInstance then + match supportTys, traitObjAndArgTys with + | [ty], h :: _ -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace h ty + | _ -> do! ErrorD (ConstraintSolverError(FSComp.SR.csExpectedArguments(), m, m2)) + + // Trait calls are only supported on pseudo type (variables) + if not (g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers) then + for e in supportTys do + do! SolveTypStaticReq csenv trace TyparStaticReq.HeadType e + + // SRTP constraints on rigid type parameters do not need to be solved + let isRigid = + supportTys |> List.forall (fun ty -> + match tryDestTyparTy g ty with + | ValueSome tp -> + match tp.Rigidity with + | TyparRigidity.Rigid + | TyparRigidity.WillBeRigid -> true + | _ -> false + | ValueNone -> false) + + let argTys = if memFlags.IsInstance then List.tail traitObjAndArgTys else traitObjAndArgTys + + let minfos = GetRelevantMethodsForTrait csenv permitWeakResolution nm traitInfo + + let! res = + trackErrors { + match minfos, supportTys, memFlags.IsInstance, nm, argTys with + | _, _, false, ("op_Division" | "op_Multiply"), [argTy1;argTy2] + when + // This simulates the existence of + // float * float -> float + // float32 * float32 -> float32 + // float<'u> * float<'v> -> float<'u 'v> + // float32<'u> * float32<'v> -> float32<'u 'v> + // decimal<'u> * decimal<'v> -> decimal<'u 'v> + // decimal<'u> * decimal -> decimal<'u> + // float32<'u> * float32<'v> -> float32<'u 'v> + // int * int -> int + // int64 * int64 -> int64 + // + // The rule is triggered by these sorts of inputs when permitWeakResolution=false + // float * float + // float * float32 // will give error + // decimal * decimal + // decimal * decimal <-- Note this one triggers even though "decimal" has some possibly-relevant methods + // float * Matrix // the rule doesn't trigger for this one since Matrix has overloads we can use and we prefer those instead + // float * Matrix // the rule doesn't trigger for this one since Matrix has overloads we can use and we prefer those instead + // + // The rule is triggered by these sorts of inputs when permitWeakResolution=true + // float * 'a + // 'a * float + // decimal<'u> * 'a + (let checkRuleAppliesInPreferenceToMethods argTy1 argTy2 = + // Check that at least one of the argument types is numeric + IsNumericOrIntegralEnumType g argTy1 && + // Check the other type is nominal, unless using weak resolution + IsBinaryOpOtherArgType g permitWeakResolution argTy2 && + // This next condition checks that either + // - Neither type contributes any methods OR + // - We have the special case "decimal<_> * decimal". In this case we have some + // possibly-relevant methods from "decimal" but we ignore them in this case. + (isNil minfos || (Option.isSome (getMeasureOfType g argTy1) && isDecimalTy g argTy2)) in + + checkRuleAppliesInPreferenceToMethods argTy1 argTy2 || + checkRuleAppliesInPreferenceToMethods argTy2 argTy1) -> + + match getMeasureOfType g argTy1 with + | Some (tcref, ms1) -> + let ms2 = freshMeasure () + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 (mkWoNullAppTy tcref [TType_measure ms2]) + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure (Measure.Prod(ms1, if nm = "op_Multiply" then ms2 else Measure.Inv ms2))]) + return TTraitBuiltIn - // Trait calls are only supported on pseudo type (variables) - if not (g.langVersion.SupportsFeature LanguageFeature.InterfacesWithAbstractStaticMembers) then - for e in supportTys do - do! SolveTypStaticReq csenv trace TyparStaticReq.HeadType e + | _ -> - // SRTP constraints on rigid type parameters do not need to be solved - let isRigid = - supportTys |> List.forall (fun ty -> - match tryDestTyparTy g ty with - | ValueSome tp -> - match tp.Rigidity with - | TyparRigidity.Rigid - | TyparRigidity.WillBeRigid -> true - | _ -> false - | ValueNone -> false) + match getMeasureOfType g argTy2 with + | Some (tcref, ms2) -> + let ms1 = freshMeasure () + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 (mkWoNullAppTy tcref [TType_measure ms1]) + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure (Measure.Prod(ms1, if nm = "op_Multiply" then ms2 else Measure.Inv ms2))]) + return TTraitBuiltIn + + | _ -> + + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 + return TTraitBuiltIn + + | _, _, false, ("op_Addition" | "op_Subtraction" | "op_Modulus"), [argTy1;argTy2] + when // Ignore any explicit +/- overloads from any basic integral types + (minfos |> List.forall (fun (_, minfo) -> isIntegerTy g minfo.ApparentEnclosingType ) && + ( IsAddSubModType nm g argTy1 && IsBinaryOpOtherArgType g permitWeakResolution argTy2 + || IsAddSubModType nm g argTy2 && IsBinaryOpOtherArgType g permitWeakResolution argTy1)) -> + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 + return TTraitBuiltIn - let argTys = if memFlags.IsInstance then List.tail traitObjAndArgTys else traitObjAndArgTys + | _, _, false, ("op_LessThan" | "op_LessThanOrEqual" | "op_GreaterThan" | "op_GreaterThanOrEqual" | "op_Equality" | "op_Inequality" ), [argTy1;argTy2] + when // Ignore any explicit overloads from any basic integral types + (minfos |> List.forall (fun (_, minfo) -> isIntegerTy g minfo.ApparentEnclosingType ) && + ( IsRelationalType g argTy1 && IsBinaryOpOtherArgType g permitWeakResolution argTy2 + || IsRelationalType g argTy2 && IsBinaryOpOtherArgType g permitWeakResolution argTy1)) -> + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy g.bool_ty + return TTraitBuiltIn - let minfos = GetRelevantMethodsForTrait csenv permitWeakResolution nm traitInfo + // We pretend for uniformity that the numeric types have a static property called Zero and One + // As with constants, only zero is polymorphic in its units + | [], [ty], false, "get_Zero", [] + when isNumericType g ty || isCharTy g ty -> + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy ty + return TTraitBuiltIn - let! res = - trackErrors { - match minfos, supportTys, memFlags.IsInstance, nm, argTys with - | _, _, false, ("op_Division" | "op_Multiply"), [argTy1;argTy2] - when - // This simulates the existence of - // float * float -> float - // float32 * float32 -> float32 - // float<'u> * float<'v> -> float<'u 'v> - // float32<'u> * float32<'v> -> float32<'u 'v> - // decimal<'u> * decimal<'v> -> decimal<'u 'v> - // decimal<'u> * decimal -> decimal<'u> - // float32<'u> * float32<'v> -> float32<'u 'v> - // int * int -> int - // int64 * int64 -> int64 - // - // The rule is triggered by these sorts of inputs when permitWeakResolution=false - // float * float - // float * float32 // will give error - // decimal * decimal - // decimal * decimal <-- Note this one triggers even though "decimal" has some possibly-relevant methods - // float * Matrix // the rule doesn't trigger for this one since Matrix has overloads we can use and we prefer those instead - // float * Matrix // the rule doesn't trigger for this one since Matrix has overloads we can use and we prefer those instead - // - // The rule is triggered by these sorts of inputs when permitWeakResolution=true - // float * 'a - // 'a * float - // decimal<'u> * 'a - (let checkRuleAppliesInPreferenceToMethods argTy1 argTy2 = - // Check that at least one of the argument types is numeric - IsNumericOrIntegralEnumType g argTy1 && - // Check the other type is nominal, unless using weak resolution - IsBinaryOpOtherArgType g permitWeakResolution argTy2 && - // This next condition checks that either - // - Neither type contributes any methods OR - // - We have the special case "decimal<_> * decimal". In this case we have some - // possibly-relevant methods from "decimal" but we ignore them in this case. - (isNil minfos || (Option.isSome (getMeasureOfType g argTy1) && isDecimalTy g argTy2)) in - - checkRuleAppliesInPreferenceToMethods argTy1 argTy2 || - checkRuleAppliesInPreferenceToMethods argTy2 argTy1) -> - - match getMeasureOfType g argTy1 with - | Some (tcref, ms1) -> - let ms2 = freshMeasure () - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 (mkWoNullAppTy tcref [TType_measure ms2]) - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure (Measure.Prod(ms1, if nm = "op_Multiply" then ms2 else Measure.Inv ms2))]) + | [], [ty], false, "get_One", [] + when isNumericType g ty || isCharTy g ty -> + do! SolveDimensionlessNumericType csenv ndeep m2 trace ty + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy ty return TTraitBuiltIn - | _ -> + | [], _, false, "DivideByInt", [argTy1;argTy2] + when isFpTy g argTy1 || isDecimalTy g argTy1 -> + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 g.int_ty + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 + return TTraitBuiltIn - match getMeasureOfType g argTy2 with - | Some (tcref, ms2) -> - let ms1 = freshMeasure () - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 (mkWoNullAppTy tcref [TType_measure ms1]) - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure (Measure.Prod(ms1, if nm = "op_Multiply" then ms2 else Measure.Inv ms2))]) - return TTraitBuiltIn + // We pretend for uniformity that the 'string' and 'array' types have an indexer property called 'Item' + | [], [ty], true, "get_Item", [argTy1] + when isStringTy g ty -> - | _ -> + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 g.int_ty + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy g.char_ty + return TTraitBuiltIn - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 - return TTraitBuiltIn + | [], [ty], true, "get_Item", argTys + when isArrayTy g ty -> + + if rankOfArrayTy g ty <> argTys.Length then + do! ErrorD(ConstraintSolverError(FSComp.SR.csIndexArgumentMismatch((rankOfArrayTy g ty), argTys.Length), m, m2)) + + for argTy in argTys do + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy g.int_ty - | _, _, false, ("op_Addition" | "op_Subtraction" | "op_Modulus"), [argTy1;argTy2] - when // Ignore any explicit +/- overloads from any basic integral types - (minfos |> List.forall (fun (_, minfo) -> isIntegerTy g minfo.ApparentEnclosingType ) && - ( IsAddSubModType nm g argTy1 && IsBinaryOpOtherArgType g permitWeakResolution argTy2 - || IsAddSubModType nm g argTy2 && IsBinaryOpOtherArgType g permitWeakResolution argTy1)) -> - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 - return TTraitBuiltIn - - | _, _, false, ("op_LessThan" | "op_LessThanOrEqual" | "op_GreaterThan" | "op_GreaterThanOrEqual" | "op_Equality" | "op_Inequality" ), [argTy1;argTy2] - when // Ignore any explicit overloads from any basic integral types - (minfos |> List.forall (fun (_, minfo) -> isIntegerTy g minfo.ApparentEnclosingType ) && - ( IsRelationalType g argTy1 && IsBinaryOpOtherArgType g permitWeakResolution argTy2 - || IsRelationalType g argTy2 && IsBinaryOpOtherArgType g permitWeakResolution argTy1)) -> - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy g.bool_ty - return TTraitBuiltIn - - // We pretend for uniformity that the numeric types have a static property called Zero and One - // As with constants, only zero is polymorphic in its units - | [], [ty], false, "get_Zero", [] - when isNumericType g ty || isCharTy g ty -> - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy ty - return TTraitBuiltIn - - | [], [ty], false, "get_One", [] - when isNumericType g ty || isCharTy g ty -> - do! SolveDimensionlessNumericType csenv ndeep m2 trace ty - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy ty - return TTraitBuiltIn - - | [], _, false, "DivideByInt", [argTy1;argTy2] - when isFpTy g argTy1 || isDecimalTy g argTy1 -> - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 g.int_ty - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 - return TTraitBuiltIn - - // We pretend for uniformity that the 'string' and 'array' types have an indexer property called 'Item' - | [], [ty], true, "get_Item", [argTy1] - when isStringTy g ty -> - - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 g.int_ty - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy g.char_ty - return TTraitBuiltIn - - | [], [ty], true, "get_Item", argTys - when isArrayTy g ty -> - - if rankOfArrayTy g ty <> argTys.Length then - do! ErrorD(ConstraintSolverError(FSComp.SR.csIndexArgumentMismatch((rankOfArrayTy g ty), argTys.Length), m, m2)) - - for argTy in argTys do - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy g.int_ty - - let ety = destArrayTy g ty - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy ety - return TTraitBuiltIn - - | [], [ty], true, "set_Item", argTys - when isArrayTy g ty -> + let ety = destArrayTy g ty + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy ety + return TTraitBuiltIn + + | [], [ty], true, "set_Item", argTys + when isArrayTy g ty -> - if rankOfArrayTy g ty <> argTys.Length - 1 then - do! ErrorD(ConstraintSolverError(FSComp.SR.csIndexArgumentMismatch((rankOfArrayTy g ty), (argTys.Length - 1)), m, m2)) - let argTys, lastTy = List.frontAndBack argTys + if rankOfArrayTy g ty <> argTys.Length - 1 then + do! ErrorD(ConstraintSolverError(FSComp.SR.csIndexArgumentMismatch((rankOfArrayTy g ty), (argTys.Length - 1)), m, m2)) + let argTys, lastTy = List.frontAndBack argTys + + for argTy in argTys do + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy g.int_ty + + let elemTy = destArrayTy g ty + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace lastTy elemTy + return TTraitBuiltIn - for argTy in argTys do - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy g.int_ty + | [], _, false, ("op_BitwiseAnd" | "op_BitwiseOr" | "op_ExclusiveOr"), [argTy1;argTy2] + when IsBitwiseOpType g argTy1 && IsBinaryOpOtherArgType g permitWeakResolution argTy2 + || IsBitwiseOpType g argTy2 && IsBinaryOpOtherArgType g permitWeakResolution argTy1 -> - let elemTy = destArrayTy g ty - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace lastTy elemTy - return TTraitBuiltIn + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 + do! SolveDimensionlessNumericType csenv ndeep m2 trace argTy1 + return TTraitBuiltIn - | [], _, false, ("op_BitwiseAnd" | "op_BitwiseOr" | "op_ExclusiveOr"), [argTy1;argTy2] - when IsBitwiseOpType g argTy1 && IsBinaryOpOtherArgType g permitWeakResolution argTy2 - || IsBitwiseOpType g argTy2 && IsBinaryOpOtherArgType g permitWeakResolution argTy1 -> + | [], _, false, ("op_LeftShift" | "op_RightShift"), [argTy1;argTy2] + when IsIntegerOrIntegerEnumTy g argTy1 -> - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 - do! SolveDimensionlessNumericType csenv ndeep m2 trace argTy1 - return TTraitBuiltIn + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 g.int_ty + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 + do! SolveDimensionlessNumericType csenv ndeep m2 trace argTy1 + return TTraitBuiltIn - | [], _, false, ("op_LeftShift" | "op_RightShift"), [argTy1;argTy2] - when IsIntegerOrIntegerEnumTy g argTy1 -> + | _, _, false, "op_UnaryPlus", [argTy] + when IsNumericOrIntegralEnumType g argTy -> - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 g.int_ty - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 - do! SolveDimensionlessNumericType csenv ndeep m2 trace argTy1 - return TTraitBuiltIn + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy + return TTraitBuiltIn - | _, _, false, "op_UnaryPlus", [argTy] - when IsNumericOrIntegralEnumType g argTy -> + | _, _, false, "op_UnaryNegation", [argTy] + when isSignedIntegerTy g argTy || isFpTy g argTy || isDecimalTy g argTy -> - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy - return TTraitBuiltIn + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy + return TTraitBuiltIn - | _, _, false, "op_UnaryNegation", [argTy] - when isSignedIntegerTy g argTy || isFpTy g argTy || isDecimalTy g argTy -> + | _, _, true, "get_Sign", [] + when IsSignType g supportTys.Head -> - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy - return TTraitBuiltIn + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy g.int32_ty + return TTraitBuiltIn - | _, _, true, "get_Sign", [] - when IsSignType g supportTys.Head -> + | _, _, false, ("op_LogicalNot" | "op_OnesComplement"), [argTy] + when IsIntegerOrIntegerEnumTy g argTy -> - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy g.int32_ty - return TTraitBuiltIn + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy + do! SolveDimensionlessNumericType csenv ndeep m2 trace argTy + return TTraitBuiltIn - | _, _, false, ("op_LogicalNot" | "op_OnesComplement"), [argTy] - when IsIntegerOrIntegerEnumTy g argTy -> + | _, _, false, "Abs", [argTy] + when isSignedIntegerTy g argTy || isFpTy g argTy || isDecimalTy g argTy -> - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy - do! SolveDimensionlessNumericType csenv ndeep m2 trace argTy - return TTraitBuiltIn + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy + return TTraitBuiltIn - | _, _, false, "Abs", [argTy] - when isSignedIntegerTy g argTy || isFpTy g argTy || isDecimalTy g argTy -> + | _, _, false, "Sqrt", [argTy1] + when isFpTy g argTy1 -> + match getMeasureOfType g argTy1 with + | Some (tcref, _) -> + let ms1 = freshMeasure () + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 (mkWoNullAppTy tcref [TType_measure (Measure.Prod (ms1, ms1))]) + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure ms1]) + return TTraitBuiltIn + | None -> + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 + return TTraitBuiltIn + + | _, _, false, ("Sin" | "Cos" | "Tan" | "Sinh" | "Cosh" | "Tanh" | "Atan" | "Acos" | "Asin" | "Exp" | "Ceiling" | "Floor" | "Round" | "Truncate" | "Log10" | "Log" | "Sqrt"), [argTy] + when isFpTy g argTy -> + + do! SolveDimensionlessNumericType csenv ndeep m2 trace argTy + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy + return TTraitBuiltIn - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy - return TTraitBuiltIn + // Conversions from non-decimal numbers / strings / chars to non-decimal numbers / chars are built-in + | _, _, false, "op_Explicit", [argTy] + when (// The input type. + (IsNonDecimalNumericOrIntegralEnumType g argTy || isStringTy g argTy || isCharTy g argTy) && + // The output type + (IsNonDecimalNumericOrIntegralEnumType g retTy || isCharTy g retTy)) -> - | _, _, false, "Sqrt", [argTy1] - when isFpTy g argTy1 -> - match getMeasureOfType g argTy1 with - | Some (tcref, _) -> - let ms1 = freshMeasure () - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 (mkWoNullAppTy tcref [TType_measure (Measure.Prod (ms1, ms1))]) - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure ms1]) - return TTraitBuiltIn - | None -> - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 - return TTraitBuiltIn + return TTraitBuiltIn + + // Conversions from (including decimal) numbers / strings / chars to decimals are built-in + | _, _, false, "op_Explicit", [argTy] + when (// The input type. + (IsNumericOrIntegralEnumType g argTy || isStringTy g argTy || isCharTy g argTy) && + // The output type + (isDecimalTy g retTy)) -> + return TTraitBuiltIn + + // Conversions from decimal numbers to native integers are built-in + // The rest of decimal conversions are handled via op_Explicit lookup on System.Decimal (which also looks for op_Implicit) + | _, _, false, "op_Explicit", [argTy] + when (// The input type. + (isDecimalTy g argTy) && + // The output type + (isNativeIntegerTy g retTy)) -> + return TTraitBuiltIn - | _, _, false, ("Sin" | "Cos" | "Tan" | "Sinh" | "Cosh" | "Tanh" | "Atan" | "Acos" | "Asin" | "Exp" | "Ceiling" | "Floor" | "Round" | "Truncate" | "Log10" | "Log" | "Sqrt"), [argTy] - when isFpTy g argTy -> - - do! SolveDimensionlessNumericType csenv ndeep m2 trace argTy - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy - return TTraitBuiltIn - - // Conversions from non-decimal numbers / strings / chars to non-decimal numbers / chars are built-in - | _, _, false, "op_Explicit", [argTy] - when (// The input type. - (IsNonDecimalNumericOrIntegralEnumType g argTy || isStringTy g argTy || isCharTy g argTy) && - // The output type - (IsNonDecimalNumericOrIntegralEnumType g retTy || isCharTy g retTy)) -> - - return TTraitBuiltIn - - // Conversions from (including decimal) numbers / strings / chars to decimals are built-in - | _, _, false, "op_Explicit", [argTy] - when (// The input type. - (IsNumericOrIntegralEnumType g argTy || isStringTy g argTy || isCharTy g argTy) && - // The output type - (isDecimalTy g retTy)) -> - return TTraitBuiltIn - - // Conversions from decimal numbers to native integers are built-in - // The rest of decimal conversions are handled via op_Explicit lookup on System.Decimal (which also looks for op_Implicit) - | _, _, false, "op_Explicit", [argTy] - when (// The input type. - (isDecimalTy g argTy) && - // The output type - (isNativeIntegerTy g retTy)) -> - return TTraitBuiltIn - - | [], _, false, "Pow", [argTy1; argTy2] - when isFpTy g argTy1 -> + | [], _, false, "Pow", [argTy1; argTy2] + when isFpTy g argTy1 -> - do! SolveDimensionlessNumericType csenv ndeep m2 trace argTy1 - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 - return TTraitBuiltIn - - | _, _, false, "Atan2", [argTy1; argTy2] - when isFpTy g argTy1 -> - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 - match getMeasureOfType g argTy1 with - | None -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 - | Some (tcref, _) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure Measure.One]) - return TTraitBuiltIn + do! SolveDimensionlessNumericType csenv ndeep m2 trace argTy1 + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 + return TTraitBuiltIn - | _ -> - // OK, this is not solved by a built-in constraint. - // Now look for real solutions - - // First look for a solution by a record property - let recdPropSearch = - let isGetProp = nm.StartsWithOrdinal("get_") - let isSetProp = nm.StartsWithOrdinal("set_") - if not isRigid && ((argTys.IsEmpty && isGetProp) || isSetProp) then - let propName = nm[4..] - let props = - supportTys |> List.choose (fun ty -> - match TryFindIntrinsicNamedItemOfType csenv.InfoReader (propName, AccessibleFromEverywhere, false) FindMemberFlag.IgnoreOverrides m ty with - | Some (RecdFieldItem rfinfo) - when (isGetProp || rfinfo.RecdField.IsMutable) && - (rfinfo.IsStatic = not memFlags.IsInstance) && - IsRecdFieldAccessible amap m AccessibleFromEverywhere rfinfo.RecdFieldRef && - not rfinfo.LiteralValue.IsSome && - not rfinfo.RecdField.IsCompilerGenerated -> - Some (rfinfo, isSetProp) - | _ -> None) - match props with - | [ prop ] -> Some prop - | _ -> None - else - None - - let anonRecdPropSearch = - let isGetProp = nm.StartsWithOrdinal("get_") - if not isRigid && isGetProp && memFlags.IsInstance then - let propName = nm[4..] - let props = - supportTys |> List.choose (fun ty -> - match TryFindAnonRecdFieldOfType g ty propName with - | Some (Item.AnonRecdField(anonInfo, tinst, i, _)) -> Some (anonInfo, tinst, i) - | _ -> None) - match props with - | [ prop ] -> Some prop - | _ -> None - else - None - - // Now check if there are no feasible solutions at all - match minfos, recdPropSearch, anonRecdPropSearch with - | [], None, None when MemberConstraintIsReadyForStrongResolution csenv traitInfo -> - if supportTys |> List.exists (isFunTy g) then - return! ErrorD (ConstraintSolverError(FSComp.SR.csExpectTypeWithOperatorButGivenFunction(ConvertValLogicalNameToDisplayNameCore nm), m, m2)) - elif supportTys |> List.exists (isAnyTupleTy g) then - return! ErrorD (ConstraintSolverError(FSComp.SR.csExpectTypeWithOperatorButGivenTuple(ConvertValLogicalNameToDisplayNameCore nm), m, m2)) - else - match nm, argTys with - | "op_Explicit", [argTy] -> - let argTyString = NicePrint.prettyStringOfTy denv argTy - let rtyString = NicePrint.prettyStringOfTy denv retTy - return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportConversion(argTyString, rtyString), m, m2)) - | _ -> - let tyString = - match supportTys with - | [ty] -> NicePrint.minimalStringOfType denv ty - | _ -> supportTys |> List.map (NicePrint.minimalStringOfType denv) |> String.concat ", " - let opName = ConvertValLogicalNameToDisplayNameCore nm - let err = - match opName with - | "?>=" | "?>" | "?<=" | "?<" | "?=" | "?<>" - | ">=?" | ">?" | "<=?" | "?" - | "?>=?" | "?>?" | "?<=?" | "??" -> - if List.isSingleton supportTys then FSComp.SR.csTypeDoesNotSupportOperatorNullable(tyString, opName) - else FSComp.SR.csTypesDoNotSupportOperatorNullable(tyString, opName) - | _ -> - match supportTys, source.Value with - | [_], Some s when s.StartsWith("Operators.") -> - let opSource = s[10..] - if opSource = nm then FSComp.SR.csTypeDoesNotSupportOperator(tyString, opName) - else FSComp.SR.csTypeDoesNotSupportOperator(tyString, opSource) - | [_], Some s -> - FSComp.SR.csFunctionDoesNotSupportType(s, tyString, nm) - | [_], _ - -> FSComp.SR.csTypeDoesNotSupportOperator(tyString, opName) - | _, _ - -> FSComp.SR.csTypesDoNotSupportOperator(tyString, opName) - return! ErrorD(ConstraintSolverError(err, m, m2)) + | _, _, false, "Atan2", [argTy1; argTy2] + when isFpTy g argTy1 -> + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 + match getMeasureOfType g argTy1 with + | None -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 + | Some (tcref, _) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkWoNullAppTy tcref [TType_measure Measure.One]) + return TTraitBuiltIn | _ -> - let dummyExpr = mkUnit g m - let calledMethGroup = - minfos - // curried members may not be used to satisfy constraints - |> List.choose (fun (staticTy, minfo) -> - if minfo.IsCurried then - None - else - let callerArgs = - { - Unnamed = [ (argTys |> List.map (fun argTy -> CallerArg(argTy, m, false, dummyExpr))) ] - Named = [ [ ] ] - } - let minst = FreshenMethInfo m minfo - let objtys = minfo.GetObjArgTypes(amap, m, minst) - Some(CalledMeth(csenv.InfoReader, None, false, FreshenMethInfo, m, AccessibleFromEverywhere, minfo, minst, minst, None, objtys, callerArgs, false, false, None, Some staticTy))) - - let methOverloadResult, errors = - trace.CollectThenUndoOrCommit - (fun (a, _) -> Option.isSome a) - (fun trace -> ResolveOverloading csenv (WithTrace trace) nm ndeep (Some traitInfo) CallerArgs.Empty AccessibleFromEverywhere calledMethGroup false (Some (MustEqual retTy))) - - match anonRecdPropSearch, recdPropSearch, methOverloadResult with - | Some (anonInfo, tinst, i), None, None -> - // OK, the constraint is solved by a record property. Assert that the return types match. - let rty2 = List.item i tinst - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy rty2 - return TTraitSolvedAnonRecdProp(anonInfo, tinst, i) - - | None, Some (rfinfo, isSetProp), None -> - // OK, the constraint is solved by a record property. Assert that the return types match. - let rty2 = if isSetProp then g.unit_ty else rfinfo.FieldType - do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy rty2 - return TTraitSolvedRecdProp(rfinfo, isSetProp) - - | None, None, Some (calledMeth: CalledMeth<_>) -> - // OK, the constraint is solved. - let minfo = calledMeth.Method - - do! errors - let isInstance = minfo.IsInstance - if isInstance <> memFlags.IsInstance then - return! - if isInstance then - ErrorD(ConstraintSolverError(FSComp.SR.csMethodFoundButIsNotStatic((NicePrint.minimalStringOfType denv minfo.ApparentEnclosingType), (ConvertValLogicalNameToDisplayNameCore nm), nm), m, m2 )) - else - ErrorD(ConstraintSolverError(FSComp.SR.csMethodFoundButIsStatic((NicePrint.minimalStringOfType denv minfo.ApparentEnclosingType), (ConvertValLogicalNameToDisplayNameCore nm), nm), m, m2 )) - else - do! CheckMethInfoAttributes g m None minfo - return TTraitSolved (minfo, calledMeth.CalledTyArgs, calledMeth.OptionalStaticType) + // OK, this is not solved by a built-in constraint. + // Now look for real solutions + + // First look for a solution by a record property + let recdPropSearch = + let isGetProp = nm.StartsWithOrdinal("get_") + let isSetProp = nm.StartsWithOrdinal("set_") + if not isRigid && ((argTys.IsEmpty && isGetProp) || isSetProp) then + let propName = nm[4..] + let props = + supportTys |> List.choose (fun ty -> + match TryFindIntrinsicNamedItemOfType csenv.InfoReader (propName, AccessibleFromEverywhere, false) FindMemberFlag.IgnoreOverrides m ty with + | Some (RecdFieldItem rfinfo) + when (isGetProp || rfinfo.RecdField.IsMutable) && + (rfinfo.IsStatic = not memFlags.IsInstance) && + IsRecdFieldAccessible amap m AccessibleFromEverywhere rfinfo.RecdFieldRef && + not rfinfo.LiteralValue.IsSome && + not rfinfo.RecdField.IsCompilerGenerated -> + Some (rfinfo, isSetProp) + | _ -> None) + match props with + | [ prop ] -> Some prop + | _ -> None + else + None + + let anonRecdPropSearch = + let isGetProp = nm.StartsWithOrdinal("get_") + if not isRigid && isGetProp && memFlags.IsInstance then + let propName = nm[4..] + let props = + supportTys |> List.choose (fun ty -> + match TryFindAnonRecdFieldOfType g ty propName with + | Some (Item.AnonRecdField(anonInfo, tinst, i, _)) -> Some (anonInfo, tinst, i) + | _ -> None) + match props with + | [ prop ] -> Some prop + | _ -> None + else + None + + // Now check if there are no feasible solutions at all + match minfos, recdPropSearch, anonRecdPropSearch with + | [], None, None when MemberConstraintIsReadyForStrongResolution csenv traitInfo -> + if supportTys |> List.exists (isFunTy g) then + return! ErrorD (ConstraintSolverError(FSComp.SR.csExpectTypeWithOperatorButGivenFunction(ConvertValLogicalNameToDisplayNameCore nm), m, m2)) + elif supportTys |> List.exists (isAnyTupleTy g) then + return! ErrorD (ConstraintSolverError(FSComp.SR.csExpectTypeWithOperatorButGivenTuple(ConvertValLogicalNameToDisplayNameCore nm), m, m2)) + else + match nm, argTys with + | "op_Explicit", [argTy] -> + let argTyString = NicePrint.prettyStringOfTy denv argTy + let rtyString = NicePrint.prettyStringOfTy denv retTy + return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportConversion(argTyString, rtyString), m, m2)) + | _ -> + let tyString = + match supportTys with + | [ty] -> NicePrint.minimalStringOfType denv ty + | _ -> supportTys |> List.map (NicePrint.minimalStringOfType denv) |> String.concat ", " + let opName = ConvertValLogicalNameToDisplayNameCore nm + let err = + match opName with + | "?>=" | "?>" | "?<=" | "?<" | "?=" | "?<>" + | ">=?" | ">?" | "<=?" | "?" + | "?>=?" | "?>?" | "?<=?" | "??" -> + if List.isSingleton supportTys then FSComp.SR.csTypeDoesNotSupportOperatorNullable(tyString, opName) + else FSComp.SR.csTypesDoNotSupportOperatorNullable(tyString, opName) + | _ -> + match supportTys, source.Value with + | [_], Some s when s.StartsWith("Operators.") -> + let opSource = s[10..] + if opSource = nm then FSComp.SR.csTypeDoesNotSupportOperator(tyString, opName) + else FSComp.SR.csTypeDoesNotSupportOperator(tyString, opSource) + | [_], Some s -> + FSComp.SR.csFunctionDoesNotSupportType(s, tyString, nm) + | [_], _ + -> FSComp.SR.csTypeDoesNotSupportOperator(tyString, opName) + | _, _ + -> FSComp.SR.csTypesDoNotSupportOperator(tyString, opName) + return! ErrorD(ConstraintSolverError(err, m, m2)) | _ -> - do! AddUnsolvedMemberConstraint csenv ndeep m2 trace permitWeakResolution ignoreUnresolvedOverload traitInfo errors - return TTraitUnsolved - } - return! RecordMemberConstraintSolution csenv.SolverState m trace traitInfo res + let dummyExpr = mkUnit g m + let calledMethGroup = + minfos + // curried members may not be used to satisfy constraints + |> List.choose (fun (staticTy, minfo) -> + if minfo.IsCurried then + None + else + let callerArgs = + { + Unnamed = [ (argTys |> List.map (fun argTy -> CallerArg(argTy, m, false, dummyExpr))) ] + Named = [ [ ] ] + } + let minst = FreshenMethInfo m minfo + let objtys = minfo.GetObjArgTypes(amap, m, minst) + Some(CalledMeth(csenv.InfoReader, None, false, FreshenMethInfo, m, AccessibleFromEverywhere, minfo, minst, minst, None, objtys, callerArgs, false, false, None, Some staticTy))) + + let methOverloadResult, errors = + trace.CollectThenUndoOrCommit + (fun (a, _) -> Option.isSome a) + (fun trace -> ResolveOverloading csenv (WithTrace trace) nm ndeep (Some traitInfo) CallerArgs.Empty AccessibleFromEverywhere calledMethGroup false (Some (MustEqual retTy))) + + match anonRecdPropSearch, recdPropSearch, methOverloadResult with + | Some (anonInfo, tinst, i), None, None -> + // OK, the constraint is solved by a record property. Assert that the return types match. + let rty2 = List.item i tinst + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy rty2 + return TTraitSolvedAnonRecdProp(anonInfo, tinst, i) + + | None, Some (rfinfo, isSetProp), None -> + // OK, the constraint is solved by a record property. Assert that the return types match. + let rty2 = if isSetProp then g.unit_ty else rfinfo.FieldType + do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy rty2 + return TTraitSolvedRecdProp(rfinfo, isSetProp) + + | None, None, Some (calledMeth: CalledMeth<_>) -> + // OK, the constraint is solved. + let minfo = calledMeth.Method + + do! errors + let isInstance = minfo.IsInstance + if isInstance <> memFlags.IsInstance then + return! + if isInstance then + ErrorD(ConstraintSolverError(FSComp.SR.csMethodFoundButIsNotStatic((NicePrint.minimalStringOfType denv minfo.ApparentEnclosingType), (ConvertValLogicalNameToDisplayNameCore nm), nm), m, m2 )) + else + ErrorD(ConstraintSolverError(FSComp.SR.csMethodFoundButIsStatic((NicePrint.minimalStringOfType denv minfo.ApparentEnclosingType), (ConvertValLogicalNameToDisplayNameCore nm), nm), m, m2 )) + else + do! CheckMethInfoAttributes g m None minfo + return TTraitSolved (minfo, calledMeth.CalledTyArgs, calledMeth.OptionalStaticType) + + | _ -> + do! AddUnsolvedMemberConstraint csenv ndeep m2 trace permitWeakResolution ignoreUnresolvedOverload traitInfo errors + return TTraitUnsolved + } + return! RecordMemberConstraintSolution csenv.SolverState m trace traitInfo res } and AddUnsolvedMemberConstraint csenv ndeep m2 trace permitWeakResolution ignoreUnresolvedOverload traitInfo errors = diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index f0656173c79..3a01eaa2efe 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -3283,7 +3283,7 @@ let AnalyzeArbitraryExprAsEnumerable (cenv: cenv) (env: TcEnv) localAlloc m expr let enumElemTy = - if isObjTy g enumElemTy then + if isObjTyAnyNullness g enumElemTy then // Look for an 'Item' property, or a set of these with consistent return types let allEquivReturnTypes (minfo: MethInfo) (others: MethInfo list) = let returnTy = minfo.GetFSharpReturnType(cenv.amap, m, []) @@ -6195,7 +6195,7 @@ and TcExprObjectExpr (cenv: cenv) overallTy env tpenv (synObjTy, argopt, binds, errorR(Error(FSComp.SR.tcCannotInheritFromErasedType(), m)) (m, intfTy, overrides), tpenv) - let realObjTy = if isObjTy g objTy && not (isNil extraImpls) then (p23 (List.head extraImpls)) else objTy + let realObjTy = if isObjTyAnyNullness g objTy && not (isNil extraImpls) then (p23 (List.head extraImpls)) else objTy TcPropagatingExprLeafThenConvert cenv overallTy realObjTy env (* canAdhoc *) m (fun () -> TcObjectExpr cenv env tpenv (objTy, realObjTy, argopt, binds, extraImpls, mObjTy, mNewExpr, m) @@ -7320,7 +7320,7 @@ and TcFormatStringExpr cenv (overallTy: OverallTy) env m tpenv (fmtString: strin let formatTy = mkPrintfFormatTy g aty bty cty dty ety // This might qualify as a format string - check via a type directed rule - let ok = not (isObjTy g overallTy.Commit) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy.Commit formatTy + let ok = not (isObjTyAnyNullness g overallTy.Commit) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy.Commit formatTy if ok then // Parse the format string to work out the phantom types @@ -7399,7 +7399,7 @@ and TcInterpolatedStringExpr cenv (overallTy: OverallTy) env m tpenv (parts: Syn Choice1Of2 (true, newFormatMethod) // ... or if that fails then may be a FormattableString by a type-directed rule.... - elif (not (isObjTy g overallTy.Commit) && + elif (not (isObjTyAnyNullness g overallTy.Commit) && ((g.system_FormattableString_tcref.CanDeref && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy.Commit g.system_FormattableString_ty) || (g.system_IFormattable_tcref.CanDeref && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy.Commit g.system_IFormattable_ty))) then @@ -7420,7 +7420,7 @@ and TcInterpolatedStringExpr cenv (overallTy: OverallTy) env m tpenv (parts: Syn | None -> languageFeatureNotSupportedInLibraryError LanguageFeature.StringInterpolation m // ... or if that fails then may be a PrintfFormat by a type-directed rule.... - elif not (isObjTy g overallTy.Commit) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy.Commit formatTy then + elif not (isObjTyAnyNullness g overallTy.Commit) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy.Commit formatTy then // And if that succeeds, the printerTy and printerResultTy must be the same (there are no curried arguments) UnifyTypes cenv env m printerTy printerResultTy diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index f4a9f033c64..24a2d5bbf6e 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/src/Compiler/Checking/InfoReader.fs @@ -1082,7 +1082,7 @@ let TryDestStandardDelegateType (infoReader: InfoReader) m ad delTy = let g = infoReader.g let (SigOfFunctionForDelegate(_, delArgTys, delRetTy, _)) = GetSigOfFunctionForDelegate infoReader delTy m ad match delArgTys with - | senderTy :: argTys when (isObjTy g senderTy) && not (List.exists (isByrefTy g) argTys) -> Some(mkRefTupledTy g argTys, delRetTy) + | senderTy :: argTys when (isObjTyAnyNullness g senderTy) && not (List.exists (isByrefTy g) argTys) -> Some(mkRefTupledTy g argTys, delRetTy) | _ -> None diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 72363943549..ac4d92141d8 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -1319,7 +1319,7 @@ let BuildNewDelegateExpr (eventInfoOpt: EventInfo option, g, amap, delegateTy, d | Some einfo -> match delArgVals with | [] -> error(nonStandardEventError einfo.EventName m) - | h :: _ when not (isObjTy g h.Type) -> error(nonStandardEventError einfo.EventName m) + | h :: _ when not (isObjTyAnyNullness g h.Type) -> error(nonStandardEventError einfo.EventName m) | h :: t -> [exprForVal m h; mkRefTupledVars g m t] | None -> if isNil delArgTys then [mkUnit g m] else List.map (exprForVal m) delArgVals diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 2eb5b14fa02..010e9e0cd8d 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -4422,14 +4422,14 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso // // Don't show GetHashCode or Equals for F# types that admit equality as an abnormal operation let isUnseenDueToBasicObjRules = - not (isObjTy g ty) && + not (isObjTyAnyNullness g ty) && not minfo.IsExtensionMember && match minfo.LogicalName with | "GetType" -> false - | "GetHashCode" -> isObjTy g minfo.ApparentEnclosingType && not (AugmentTypeDefinitions.TypeDefinitelyHasEquality g ty) + | "GetHashCode" -> isObjTyAnyNullness g minfo.ApparentEnclosingType && not (AugmentTypeDefinitions.TypeDefinitelyHasEquality g ty) | "ToString" -> false | "Equals" -> - if not (isObjTy g minfo.ApparentEnclosingType) then + if not (isObjTyAnyNullness g minfo.ApparentEnclosingType) then // declaring type is not System.Object - show it false elif minfo.IsInstance then @@ -4440,7 +4440,7 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso true | _ -> // filter out self methods of obj type - isObjTy g minfo.ApparentEnclosingType + isObjTyAnyNullness g minfo.ApparentEnclosingType let result = not isUnseenDueToBasicObjRules && @@ -5121,14 +5121,14 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty ( // // Don't show GetHashCode or Equals for F# types that admit equality as an abnormal operation let isUnseenDueToBasicObjRules = - not (isObjTy g ty) && + not (isObjTyAnyNullness g ty) && not minfo.IsExtensionMember && match minfo.LogicalName with | "GetType" -> false - | "GetHashCode" -> isObjTy g minfo.ApparentEnclosingType && not (AugmentTypeDefinitions.TypeDefinitelyHasEquality g ty) + | "GetHashCode" -> isObjTyAnyNullness g minfo.ApparentEnclosingType && not (AugmentTypeDefinitions.TypeDefinitelyHasEquality g ty) | "ToString" -> false | "Equals" -> - if not (isObjTy g minfo.ApparentEnclosingType) then + if not (isObjTyAnyNullness g minfo.ApparentEnclosingType) then // declaring type is not System.Object - show it false elif minfo.IsInstance then @@ -5139,7 +5139,7 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty ( true | _ -> // filter out self methods of obj type - isObjTy g minfo.ApparentEnclosingType + isObjTyAnyNullness g minfo.ApparentEnclosingType let result = not isUnseenDueToBasicObjRules && not minfo.IsInstance = statics && diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index 812837a3edd..09e8708b894 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -2191,7 +2191,7 @@ module TastDefinitionPrinting = let inherits = [ if not (suppressInheritanceAndInterfacesForTyInSimplifiedDisplays g amap m ty) then match GetSuperTypeOfType g amap m ty with - | Some superTy when not (isObjTy g superTy) && not (isValueTypeTy g superTy) -> + | Some superTy when not (isObjTyAnyNullness g superTy) && not (isValueTypeTy g superTy) -> superTy | _ -> () ] diff --git a/src/Compiler/Checking/TypeHierarchy.fs b/src/Compiler/Checking/TypeHierarchy.fs index ddccdddd637..9bf7c2ec892 100644 --- a/src/Compiler/Checking/TypeHierarchy.fs +++ b/src/Compiler/Checking/TypeHierarchy.fs @@ -67,7 +67,7 @@ let GetSuperTypeOfType g amap m ty = Some (instType (mkInstForAppTy g ty) (superOfTycon g tcref.Deref)) elif isArrayTy g ty then Some g.system_Array_ty - elif isRefTy g ty && not (isObjTy g ty) then + elif isRefTy g ty && not (isObjTyAnyNullness g ty) then Some g.obj_ty_noNulls elif isStructTupleTy g ty then Some g.system_Value_ty diff --git a/src/Compiler/Checking/TypeRelations.fs b/src/Compiler/Checking/TypeRelations.fs index b52a1da1574..498fd3e3bb8 100644 --- a/src/Compiler/Checking/TypeRelations.fs +++ b/src/Compiler/Checking/TypeRelations.fs @@ -117,7 +117,7 @@ let rec TypeFeasiblySubsumesType ndeep g amap m ty1 canCoerce ty2 = | _ -> // F# reference types are subtypes of type 'obj' - (isObjTy g ty1 && (canCoerce = CanCoerce || isRefTy g ty2)) + (isObjTyAnyNullness g ty1 && (canCoerce = CanCoerce || isRefTy g ty2)) || (isAppTy g ty2 && (canCoerce = CanCoerce || isRefTy g ty2) && diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index 23afa7bece5..18add6588d0 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -207,7 +207,7 @@ type OptionalArgInfo = if isByrefTy g ty then let ty = destByrefTy g ty PassByRef (ty, analyze ty) - elif isObjTy g ty then + elif isObjTyAnyNullness g ty then match ilParam.Marshal with | Some(ILNativeType.IUnknown | ILNativeType.IDispatch | ILNativeType.Interface) -> Constant ILFieldInit.Null | _ -> @@ -296,7 +296,7 @@ let CrackParamAttribsInfo g (ty: TType, argInfo: ArgReprInfo) = | None -> // Do a type-directed analysis of the type to determine the default value to pass. // Similar rules as OptionalArgInfo.FromILParameter are applied here, except for the COM and byref-related stuff. - CallerSide (if isObjTy g ty then MissingValue else DefaultValue) + CallerSide (if isObjTyAnyNullness g ty then MissingValue else DefaultValue) | Some attr -> let defaultValue = OptionalArgInfo.ValueOfDefaultParameterValueAttrib attr match defaultValue with @@ -364,7 +364,9 @@ type ILFieldInit with | :? uint32 as i -> ILFieldInit.UInt32 i | :? int64 as i -> ILFieldInit.Int64 i | :? uint64 as i -> ILFieldInit.UInt64 i - | _ -> error(Error(FSComp.SR.infosInvalidProvidedLiteralValue(try !!v.ToString() with _ -> "?"), m)) + | _ -> + let txt = match v with | null -> "?" | v -> try !!v.ToString() with _ -> "?" + error(Error(FSComp.SR.infosInvalidProvidedLiteralValue(txt), m)) /// Compute the OptionalArgInfo for a provided parameter. @@ -382,7 +384,7 @@ let OptionalArgInfoOfProvidedParameter (amap: ImportMap) m (provParam : Tainted< if isByrefTy g ty then let ty = destByrefTy g ty PassByRef (ty, analyze ty) - elif isObjTy g ty then MissingValue + elif isObjTyAnyNullness g ty then MissingValue else DefaultValue let paramTy = ImportProvidedType amap m (provParam.PApply((fun p -> p.ParameterType), m)) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 82572ea888a..2f3db5be2ad 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -3782,11 +3782,11 @@ and GenCoerce cenv cgbuf eenv (e, tgtTy, m, srcTy) sequel = else GenExpr cenv cgbuf eenv e Continue - if not (isObjTy g srcTy) then + if not (isObjTyAnyNullness g srcTy) then let ilFromTy = GenType cenv m eenv.tyenv srcTy CG.EmitInstr cgbuf (pop 1) (Push [ g.ilg.typ_Object ]) (I_box ilFromTy) - if not (isObjTy g tgtTy) then + if not (isObjTyAnyNullness g tgtTy) then let ilToTy = GenType cenv m eenv.tyenv tgtTy CG.EmitInstr cgbuf (pop 1) (Push [ ilToTy ]) (I_unbox_any ilToTy) @@ -12118,7 +12118,7 @@ let LookupGeneratedValue (cenv: cenv) (ctxt: ExecutionContext) eenv (v: Val) = None // Invoke the set_Foo method for a declaration with a value. Used to create variables with values programmatically in fsi.exe. -let SetGeneratedValue (ctxt: ExecutionContext) eenv isForced (v: Val) (value: obj) = +let SetGeneratedValue (ctxt: ExecutionContext) eenv isForced (v: Val) (value: objnull) = try match StorageForVal v.Range v eenv with | StaticPropertyWithField(fspec, _, hasLiteralAttr, _, _, _, _f, ilSetterMethRef, _) -> diff --git a/src/Compiler/DependencyManager/DependencyProvider.fs b/src/Compiler/DependencyManager/DependencyProvider.fs index 709899e9a05..a241880e620 100644 --- a/src/Compiler/DependencyManager/DependencyProvider.fs +++ b/src/Compiler/DependencyManager/DependencyProvider.fs @@ -160,19 +160,19 @@ type ReflectionDependencyManagerProvider let instance = if not (isNull (theType.GetConstructor([| typeof; typeof |]))) then - Activator.CreateInstance(theType, [| outputDir :> obj; useResultsCache :> obj |]) + Activator.CreateInstance(theType, [| outputDir :> objnull; useResultsCache :> objnull |]) else - Activator.CreateInstance(theType, [| outputDir :> obj |]) + Activator.CreateInstance(theType, [| outputDir :> objnull |]) - let nameProperty = nameProperty.GetValue >> string - let keyProperty = keyProperty.GetValue >> string + let nameProperty (x: objnull) = x |> nameProperty.GetValue |> string + let keyProperty (x: objnull) = x |> keyProperty.GetValue |> string - let helpMessagesProperty = - let toStringArray (o: obj) = o :?> string[] + let helpMessagesProperty (x: objnull) = + let toStringArray (o: objnull) = o :?> string[] match helpMessagesProperty with - | Some helpMessagesProperty -> helpMessagesProperty.GetValue >> toStringArray - | None -> fun _ -> [||] + | Some helpMessagesProperty -> x |> helpMessagesProperty.GetValue |> toStringArray + | None -> [||] static member InstanceMaker(theType: Type, outputDir: string option, useResultsCache: bool) = match @@ -453,14 +453,18 @@ type ReflectionDependencyManagerProvider None, [||] match method with + | None -> ReflectionDependencyManagerProvider.MakeResultFromFields(false, [||], [||], Seq.empty, Seq.empty, Seq.empty) | Some m -> - let result = m.Invoke(instance, arguments) + match m.Invoke(instance, arguments) with + | null -> ReflectionDependencyManagerProvider.MakeResultFromFields(false, [||], [||], Seq.empty, Seq.empty, Seq.empty) // Verify the number of arguments returned in the tuple returned by resolvedependencies, it can be: // 1 - object with properties // 3 - (bool * string list * string list) // Support legacy api return shape (bool, seq, seq) --- original paket packagemanager - if FSharpType.IsTuple(result.GetType()) then + | result when FSharpType.IsTuple(result.GetType()) |> not -> + ReflectionDependencyManagerProvider.MakeResultFromObject(result) + | result -> // Verify the number of arguments returned in the tuple returned by resolvedependencies, it can be: // 3 - (bool * string list * string list) let success, sourceFiles, packageRoots = @@ -474,10 +478,6 @@ type ReflectionDependencyManagerProvider | _ -> false, seqEmpty, seqEmpty ReflectionDependencyManagerProvider.MakeResultFromFields(success, [||], [||], Seq.empty, sourceFiles, packageRoots) - else - ReflectionDependencyManagerProvider.MakeResultFromObject(result) - - | None -> ReflectionDependencyManagerProvider.MakeResultFromFields(false, [||], [||], Seq.empty, Seq.empty, Seq.empty) /// Provides DependencyManagement functions. /// Class is IDisposable diff --git a/src/Compiler/Driver/GraphChecking/Graph.fs b/src/Compiler/Driver/GraphChecking/Graph.fs index 210ca927c7f..6bfb1199181 100644 --- a/src/Compiler/Driver/GraphChecking/Graph.fs +++ b/src/Compiler/Driver/GraphChecking/Graph.fs @@ -83,7 +83,7 @@ module internal Graph = graph |> Seq.iter (fun (KeyValue(file, deps)) -> printfn $"{file} -> {deps |> Array.map nodePrinter |> join}") - let print (graph: Graph<'Node>) : unit = + let print (graph: Graph<'Node> when 'Node: not null) : unit = printCustom graph (fun node -> node.ToString() |> string) let serialiseToMermaid (graph: Graph) = diff --git a/src/Compiler/Driver/GraphChecking/Graph.fsi b/src/Compiler/Driver/GraphChecking/Graph.fsi index a93e429d2fe..2caf421dc54 100644 --- a/src/Compiler/Driver/GraphChecking/Graph.fsi +++ b/src/Compiler/Driver/GraphChecking/Graph.fsi @@ -20,7 +20,7 @@ module internal Graph = /// Create a reverse of the graph. val reverse<'Node when 'Node: equality> : originalGraph: Graph<'Node> -> Graph<'Node> /// Print the contents of the graph to the standard output. - val print: graph: Graph<'Node> -> unit + val print: graph: Graph<'Node> -> unit when 'Node: not null /// Create a simple Mermaid graph val serialiseToMermaid: graph: Graph -> string /// Create a simple Mermaid graph and save it under the path specified. diff --git a/src/Compiler/Facilities/prim-parsing.fs b/src/Compiler/Facilities/prim-parsing.fs index 3088a5579ed..bb61e76e5f3 100644 --- a/src/Compiler/Facilities/prim-parsing.fs +++ b/src/Compiler/Facilities/prim-parsing.fs @@ -14,7 +14,7 @@ exception Accept of obj [] type internal IParseState - (ruleStartPoss: Position[], ruleEndPoss: Position[], lhsPos: Position[], ruleValues: obj[], lexbuf: LexBuffer) = + (ruleStartPoss: Position[], ruleEndPoss: Position[], lhsPos: Position[], ruleValues: objnull[], lexbuf: LexBuffer) = member _.LexBuffer = lexbuf member _.InputRange index = @@ -125,7 +125,7 @@ type Stack<'a>(n) = member buf.PrintStack() = for i = 0 to (count - 1) do - Console.Write("{0}{1}", contents[i], (if i = count - 1 then ":" else "-")) + Console.Write("{0}{1}", contents[i] :> objnull, (if i = count - 1 then ":" else "-")) module Flags = #if DEBUG @@ -231,7 +231,7 @@ module internal Implementation = [] [] type ValueInfo = - val value: obj + val value: objnull val startPos: Position val endPos: Position @@ -269,7 +269,7 @@ module internal Implementation = // The 100 here means a maximum of 100 elements for each rule let ruleStartPoss = (Array.zeroCreate 100: Position[]) let ruleEndPoss = (Array.zeroCreate 100: Position[]) - let ruleValues = (Array.zeroCreate 100: obj[]) + let ruleValues = (Array.zeroCreate 100: objnull[]) let lhsPos = (Array.zeroCreate 2: Position[]) let reductions = tables.reductions let cacheSize = 7919 // the 1000'th prime diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 10991bb59f7..74fcc37340c 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -4693,7 +4693,7 @@ type FsiEvaluationSession let lexResourceManager = LexResourceManager() /// The lock stops the type checker running at the same time as the server intellisense implementation. - let tcLockObject = box 7 // any new object will do + let tcLockObject = box 7 |> Unchecked.nonNull // any new object will do let resolveAssemblyRef (aref: ILAssemblyRef) = // Explanation: This callback is invoked during compilation to resolve assembly references diff --git a/src/Compiler/Symbols/Exprs.fs b/src/Compiler/Symbols/Exprs.fs index 15b1bb2a3f6..91480597cc2 100644 --- a/src/Compiler/Symbols/Exprs.fs +++ b/src/Compiler/Symbols/Exprs.fs @@ -121,7 +121,7 @@ type E = | ValueSet of FSharpMemberOrFunctionOrValue * FSharpExpr | Unused | DefaultValue of FSharpType - | Const of obj * FSharpType + | Const of objnull * FSharpType | AddressOf of FSharpExpr | Sequential of FSharpExpr * FSharpExpr | IntegerForLoop of FSharpExpr * FSharpExpr * FSharpExpr * bool * DebugPointAtFor * DebugPointAtInOrTo diff --git a/src/Compiler/SyntaxTree/ParseHelpers.fs b/src/Compiler/SyntaxTree/ParseHelpers.fs index 22c27eeb9b0..8d62a724972 100644 --- a/src/Compiler/SyntaxTree/ParseHelpers.fs +++ b/src/Compiler/SyntaxTree/ParseHelpers.fs @@ -108,7 +108,7 @@ module LexbufLocalXmlDocStore = |> unbox let ClearXmlDoc (lexbuf: Lexbuf) = - lexbuf.BufferLocalStore[xmlDocKey] <- box (XmlDocCollector()) + lexbuf.BufferLocalStore[xmlDocKey] <- box (XmlDocCollector()) |> Unchecked.nonNull /// Called from the lexer to save a single line of XML doc comment. let SaveXmlDocLine (lexbuf: Lexbuf, lineText, range: range) = diff --git a/src/Compiler/TypedTree/TypeProviders.fs b/src/Compiler/TypedTree/TypeProviders.fs index 78baba4ee9d..5c81312e135 100644 --- a/src/Compiler/TypedTree/TypeProviders.fs +++ b/src/Compiler/TypedTree/TypeProviders.fs @@ -979,7 +979,7 @@ type ProvidedExprType = | ProvidedTryFinallyExpr of ProvidedExpr * ProvidedExpr | ProvidedLambdaExpr of ProvidedVar * ProvidedExpr | ProvidedCallExpr of ProvidedExpr option * ProvidedMethodInfo * ProvidedExpr[] - | ProvidedConstantExpr of obj * ProvidedType + | ProvidedConstantExpr of objnull * ProvidedType | ProvidedDefaultExpr of ProvidedType | ProvidedNewTupleExpr of ProvidedExpr[] | ProvidedTupleGetExpr of ProvidedExpr * int diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index e7c4576b24e..186c3655312 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -1853,7 +1853,20 @@ let isArray1DTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _, _) - let isUnitTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _, _) -> tyconRefEq g g.unit_tcr_canon tcref | _ -> false) -let isObjTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _, _) -> tyconRefEq g g.system_Object_tcref tcref | _ -> false) +let isObjTyAnyNullness g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _, _) -> tyconRefEq g g.system_Object_tcref tcref | _ -> false) + +let isObjNullTy g ty = + ty + |> stripTyEqns g + |> (function TType_app(tcref, _, n) when (not g.checkNullness) || (n.TryEvaluate() <> ValueSome(NullnessInfo.WithoutNull)) + -> tyconRefEq g g.system_Object_tcref tcref | _ -> false) + +let isObjTyWithoutNull (g:TcGlobals) ty = + g.checkNullness && + ty + |> stripTyEqns g + |> (function TType_app(tcref, _, n) when (n.TryEvaluate() = ValueSome(NullnessInfo.WithoutNull)) + -> tyconRefEq g g.system_Object_tcref tcref | _ -> false) let isValueTypeTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _, _) -> tyconRefEq g g.system_Value_tcref tcref | _ -> false) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 8c17d530762..85c2adaab91 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -1666,8 +1666,14 @@ val rankOfArrayTyconRef: TcGlobals -> TyconRef -> int /// Determine if a type is the F# unit type val isUnitTy: TcGlobals -> TType -> bool -/// Determine if a type is the System.Object type -val isObjTy: TcGlobals -> TType -> bool +/// Determine if a type is the System.Object type with any nullness qualifier +val isObjTyAnyNullness: TcGlobals -> TType -> bool + +/// Determine if a type is the (System.Object | null) type. Allows either nullness if null checking is disabled. +val isObjNullTy: TcGlobals -> TType -> bool + +/// Determine if a type is a strictly non-nullable System.Object type. If nullness checking is disabled, this returns false. +val isObjTyWithoutNull: TcGlobals -> TType -> bool /// Determine if a type is the System.ValueType type val isValueTypeTy: TcGlobals -> TType -> bool diff --git a/src/Compiler/Utilities/FileSystem.fs b/src/Compiler/Utilities/FileSystem.fs index cb8c1cdbea8..a541234199e 100644 --- a/src/Compiler/Utilities/FileSystem.fs +++ b/src/Compiler/Utilities/FileSystem.fs @@ -157,7 +157,7 @@ type ByteArrayMemory(bytes: byte[], offset, length) = type SafeUnmanagedMemoryStream = inherit UnmanagedMemoryStream - val mutable private holder: obj + val mutable private holder: objnull val mutable private isDisposed: bool new(addr, length, holder) = diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index 6c5a52a2fd8..e09c650e39b 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -1139,7 +1139,7 @@ module IPartialEqualityComparer = member _.GetHashCode(Wrap x) = per.GetHashCode x } // Wrap a Wrap _ around all keys in case the key type is itself a type using null as a representation - let dict = Dictionary, obj>(wper) + let dict = Dictionary, _>(wper) seq |> List.filter (fun v -> diff --git a/src/Compiler/Utilities/sformat.fs b/src/Compiler/Utilities/sformat.fs index 9279bf093d0..f6fc27b1e51 100644 --- a/src/Compiler/Utilities/sformat.fs +++ b/src/Compiler/Utilities/sformat.fs @@ -1012,7 +1012,7 @@ module Display = // Recursive descent let rec nestedObjL depthLim prec (x: obj, ty: Type) = objL ShowAll depthLim prec (x, ty) - and objL showMode depthLim prec (x: obj, ty: Type) = + and objL showMode depthLim prec (x: objnull, ty: Type) = let info = Value.GetValueInfo bindingFlags (x, ty) try if depthLim <= 0 || exceededPrintSize () then @@ -1337,9 +1337,6 @@ module Display = if word = "map" - && (match v with - | null -> false - | _ -> true) && tyv.IsGenericType && tyv.GetGenericTypeDefinition() = typedefof> then diff --git a/src/Compiler/Utilities/sr.fs b/src/Compiler/Utilities/sr.fs index 9473cc8d78e..10a615846e3 100644 --- a/src/Compiler/Utilities/sr.fs +++ b/src/Compiler/Utilities/sr.fs @@ -27,7 +27,7 @@ module internal DiagnosticMessage = open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators - let mkFunctionValue (tys: System.Type[]) (impl: obj -> obj) = + let mkFunctionValue (tys: System.Type[]) (impl: objnull -> objnull) = FSharpValue.MakeFunction(FSharpType.MakeFunctionType(tys[0], tys[1]), impl) let funTyC = typeof obj>.GetGenericTypeDefinition() diff --git a/src/FSharp.Build/FSharpEmbedResourceText.fs b/src/FSharp.Build/FSharpEmbedResourceText.fs index ac0adf8329d..061715184de 100644 --- a/src/FSharp.Build/FSharpEmbedResourceText.fs +++ b/src/FSharp.Build/FSharpEmbedResourceText.fs @@ -295,7 +295,7 @@ open Printf #endif - static let mkFunctionValue (tys: System.Type[]) (impl:obj->obj) = + static let mkFunctionValue (tys: System.Type[]) (impl:objnull->objnull) = FSharpValue.MakeFunction(FSharpType.MakeFunctionType(tys.[0],tys.[1]), impl) static let funTyC = typeof<(obj -> obj)>.GetGenericTypeDefinition() diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/GenericCode.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/GenericCode.fs new file mode 100644 index 00000000000..06c0b1f3031 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/GenericCode.fs @@ -0,0 +1,19 @@ +module MyLibrary +let strictlyNotNull (x:obj) = () + +let myGenericFunction1 (p:_|null) = + match p with + | null -> () + | p -> strictlyNotNull p + +let myGenericFunction2 p = + match p with + | Null -> () + | NonNull p -> strictlyNotNull p + +let myGenericFunction3 p = + match p with + | null -> () + // By the time we typecheck `| null`, we assign T to be a nullable type. Imagine there could be plenty of code before this pattern match got to be typechecked. + // As of now, the inference decision in the middle of a function cannot suddenly switch from (T which supports null) (T | null, where T is not nullable) + | pnn -> strictlyNotNull (pnn |> Unchecked.nonNull) \ No newline at end of file diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/GenericCode.fs.il.net472.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/GenericCode.fs.il.net472.bsl new file mode 100644 index 00000000000..0e958b024af --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/GenericCode.fs.il.net472.bsl @@ -0,0 +1,222 @@ + + + + + +.assembly extern runtime { } +.assembly extern FSharp.Core { } +.assembly assembly +{ + .hash algorithm 0x00008004 + .ver 0:0:0:0 +} +.module assembly.dll + +.imagebase {value} +.file alignment 0x00000200 +.stackreserve 0x00100000 +.subsystem 0x0003 +.corflags 0x00000001 + + + + + +.class public abstract auto ansi sealed MyLibrary + extends [runtime]System.Object +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) + .custom instance void System.Runtime.CompilerServices.NullableContextAttribute::.ctor(uint8) = ( 01 00 01 00 00 ) + .method public static void strictlyNotNull(object x) cil managed + { + + .maxstack 8 + IL_0000: ret + } + + .method public static void myGenericFunction1(!!a p) cil managed + { + .param type a + .custom instance void System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 01 00 00 ) + .param [1] + .custom instance void System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 02 00 00 ) + + .maxstack 3 + .locals init (!!a V_0, + !!a V_1) + IL_0000: ldarg.0 + IL_0001: stloc.0 + IL_0002: ldloc.0 + IL_0003: box !!a + IL_0008: brfalse.s IL_000c + + IL_000a: br.s IL_000d + + IL_000c: ret + + IL_000d: ldloc.0 + IL_000e: stloc.1 + IL_000f: ldloc.1 + IL_0010: box !!a + IL_0015: call void MyLibrary::strictlyNotNull(object) + IL_001a: ret + } + + .method public static void myGenericFunction2(!!a p) cil managed + { + .param type a + .custom instance void System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 01 00 00 ) + .param [1] + .custom instance void System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 02 00 00 ) + + .maxstack 3 + .locals init (!!a V_0, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpChoice`2 V_1, + !!a V_2, + !!a V_3) + IL_0000: ldarg.0 + IL_0001: stloc.0 + IL_0002: ldloc.0 + IL_0003: stloc.2 + IL_0004: ldloc.2 + IL_0005: box !!a + IL_000a: brfalse.s IL_000e + + IL_000c: br.s IL_0016 + + IL_000e: ldnull + IL_000f: call class [FSharp.Core]Microsoft.FSharp.Core.FSharpChoice`2 class [FSharp.Core]Microsoft.FSharp.Core.FSharpChoice`2::NewChoice1Of2(!0) + IL_0014: br.s IL_001c + + IL_0016: ldloc.2 + IL_0017: call class [FSharp.Core]Microsoft.FSharp.Core.FSharpChoice`2 class [FSharp.Core]Microsoft.FSharp.Core.FSharpChoice`2::NewChoice2Of2(!1) + IL_001c: stloc.1 + IL_001d: ldloc.1 + IL_001e: isinst class [FSharp.Core]Microsoft.FSharp.Core.FSharpChoice`2/Choice2Of2 + IL_0023: brfalse.s IL_0027 + + IL_0025: br.s IL_0028 + + IL_0027: ret + + IL_0028: ldloc.1 + IL_0029: castclass class [FSharp.Core]Microsoft.FSharp.Core.FSharpChoice`2/Choice2Of2 + IL_002e: call instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpChoice`2/Choice2Of2::get_Item() + IL_0033: stloc.3 + IL_0034: ldloc.3 + IL_0035: box !!a + IL_003a: call void MyLibrary::strictlyNotNull(object) + IL_003f: ret + } + + .method public static void myGenericFunction3(!!a p) cil managed + { + .param type a + .custom instance void System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 01 00 00 ) + .param [1] + .custom instance void System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 02 00 00 ) + + .maxstack 3 + .locals init (!!a V_0, + !!a V_1, + !!a V_2, + !!a V_3) + IL_0000: ldarg.0 + IL_0001: stloc.0 + IL_0002: ldloc.0 + IL_0003: box !!a + IL_0008: brfalse.s IL_000c + + IL_000a: br.s IL_000d + + IL_000c: ret + + IL_000d: ldloc.0 + IL_000e: stloc.1 + IL_000f: ldloc.1 + IL_0010: stloc.2 + IL_0011: ldloc.2 + IL_0012: stloc.3 + IL_0013: ldloc.3 + IL_0014: box !!a + IL_0019: call void MyLibrary::strictlyNotNull(object) + IL_001e: ret + } + +} + +.class private abstract auto ansi sealed ''.$MyLibrary + extends [runtime]System.Object +{ +} + +.class private auto ansi beforefieldinit System.Runtime.CompilerServices.NullableAttribute + extends [runtime]System.Attribute +{ + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .field public uint8[] NullableFlags + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method public specialname rtspecialname instance void .ctor(uint8 scalarByteValue) cil managed + { + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void [runtime]System.Attribute::.ctor() + IL_0006: ldarg.0 + IL_0007: ldc.i4.1 + IL_0008: newarr [runtime]System.Byte + IL_000d: dup + IL_000e: ldc.i4.0 + IL_000f: ldarg.1 + IL_0010: stelem.i1 + IL_0011: stfld uint8[] System.Runtime.CompilerServices.NullableAttribute::NullableFlags + IL_0016: ret + } + + .method public specialname rtspecialname instance void .ctor(uint8[] NullableFlags) cil managed + { + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void [runtime]System.Attribute::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld uint8[] System.Runtime.CompilerServices.NullableAttribute::NullableFlags + IL_000d: ret + } + +} + +.class private auto ansi beforefieldinit System.Runtime.CompilerServices.NullableContextAttribute + extends [runtime]System.Attribute +{ + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .field public uint8 Flag + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + .method public specialname rtspecialname instance void .ctor(uint8 Flag) cil managed + { + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + .custom instance void [runtime]System.Diagnostics.DebuggerNonUserCodeAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 8 + IL_0000: ldarg.0 + IL_0001: call instance void [runtime]System.Attribute::.ctor() + IL_0006: ldarg.0 + IL_0007: ldarg.1 + IL_0008: stfld uint8 System.Runtime.CompilerServices.NullableContextAttribute::Flag + IL_000d: ret + } + +} + + + + + + diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/GenericCode.fs.il.netcore.bsl b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/GenericCode.fs.il.netcore.bsl new file mode 100644 index 00000000000..ca54c9be1ee --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/GenericCode.fs.il.netcore.bsl @@ -0,0 +1,157 @@ + + + + + +.assembly extern runtime { } +.assembly extern FSharp.Core { } +.assembly assembly +{ + .hash algorithm 0x00008004 + .ver 0:0:0:0 +} +.module assembly.dll + +.imagebase {value} +.file alignment 0x00000200 +.stackreserve 0x00100000 +.subsystem 0x0003 +.corflags 0x00000001 + + + + + +.class public abstract auto ansi sealed MyLibrary + extends [runtime]System.Object +{ + .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationMappingAttribute::.ctor(valuetype [FSharp.Core]Microsoft.FSharp.Core.SourceConstructFlags) = ( 01 00 07 00 00 00 00 00 ) + .custom instance void [runtime]System.Runtime.CompilerServices.NullableContextAttribute::.ctor(uint8) = ( 01 00 01 00 00 ) + .method public static void strictlyNotNull(object x) cil managed + { + + .maxstack 8 + IL_0000: ret + } + + .method public static void myGenericFunction1(!!a p) cil managed + { + .param type a + .custom instance void [runtime]System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 01 00 00 ) + .param [1] + .custom instance void [runtime]System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 02 00 00 ) + + .maxstack 3 + .locals init (!!a V_0, + !!a V_1) + IL_0000: ldarg.0 + IL_0001: stloc.0 + IL_0002: ldloc.0 + IL_0003: box !!a + IL_0008: brfalse.s IL_000c + + IL_000a: br.s IL_000d + + IL_000c: ret + + IL_000d: ldloc.0 + IL_000e: stloc.1 + IL_000f: ldloc.1 + IL_0010: box !!a + IL_0015: call void MyLibrary::strictlyNotNull(object) + IL_001a: ret + } + + .method public static void myGenericFunction2(!!a p) cil managed + { + .param type a + .custom instance void [runtime]System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 01 00 00 ) + .param [1] + .custom instance void [runtime]System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 02 00 00 ) + + .maxstack 3 + .locals init (!!a V_0, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpChoice`2 V_1, + !!a V_2, + !!a V_3) + IL_0000: ldarg.0 + IL_0001: stloc.0 + IL_0002: ldloc.0 + IL_0003: stloc.2 + IL_0004: ldloc.2 + IL_0005: box !!a + IL_000a: brfalse.s IL_000e + + IL_000c: br.s IL_0016 + + IL_000e: ldnull + IL_000f: call class [FSharp.Core]Microsoft.FSharp.Core.FSharpChoice`2 class [FSharp.Core]Microsoft.FSharp.Core.FSharpChoice`2::NewChoice1Of2(!0) + IL_0014: br.s IL_001c + + IL_0016: ldloc.2 + IL_0017: call class [FSharp.Core]Microsoft.FSharp.Core.FSharpChoice`2 class [FSharp.Core]Microsoft.FSharp.Core.FSharpChoice`2::NewChoice2Of2(!1) + IL_001c: stloc.1 + IL_001d: ldloc.1 + IL_001e: isinst class [FSharp.Core]Microsoft.FSharp.Core.FSharpChoice`2/Choice2Of2 + IL_0023: brfalse.s IL_0027 + + IL_0025: br.s IL_0028 + + IL_0027: ret + + IL_0028: ldloc.1 + IL_0029: castclass class [FSharp.Core]Microsoft.FSharp.Core.FSharpChoice`2/Choice2Of2 + IL_002e: call instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpChoice`2/Choice2Of2::get_Item() + IL_0033: stloc.3 + IL_0034: ldloc.3 + IL_0035: box !!a + IL_003a: call void MyLibrary::strictlyNotNull(object) + IL_003f: ret + } + + .method public static void myGenericFunction3(!!a p) cil managed + { + .param type a + .custom instance void [runtime]System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 01 00 00 ) + .param [1] + .custom instance void [runtime]System.Runtime.CompilerServices.NullableAttribute::.ctor(uint8) = ( 01 00 02 00 00 ) + + .maxstack 3 + .locals init (!!a V_0, + !!a V_1, + !!a V_2, + !!a V_3) + IL_0000: ldarg.0 + IL_0001: stloc.0 + IL_0002: ldloc.0 + IL_0003: box !!a + IL_0008: brfalse.s IL_000c + + IL_000a: br.s IL_000d + + IL_000c: ret + + IL_000d: ldloc.0 + IL_000e: stloc.1 + IL_000f: ldloc.1 + IL_0010: stloc.2 + IL_0011: ldloc.2 + IL_0012: stloc.3 + IL_0013: ldloc.3 + IL_0014: box !!a + IL_0019: call void MyLibrary::strictlyNotNull(object) + IL_001e: ret + } + +} + +.class private abstract auto ansi sealed ''.$MyLibrary + extends [runtime]System.Object +{ +} + + + + + + diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/NullnessMetadata.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/NullnessMetadata.fs index 3476cf07b2e..f0ebdfa0c34 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/NullnessMetadata.fs +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Nullness/NullnessMetadata.fs @@ -89,6 +89,12 @@ let ``SupportsNull`` compilation = |> withNoWarn 52 |> verifyCompilation DoNotOptimize +[] +let ``GenericCode`` compilation = + compilation + |> withNoWarn 52 + |> verifyCompilation DoNotOptimize + module Interop = open System.IO diff --git a/tests/FSharp.Compiler.ComponentTests/Language/Nullness/NullableReferenceTypesTests.fs b/tests/FSharp.Compiler.ComponentTests/Language/Nullness/NullableReferenceTypesTests.fs index de6d1c888ca..1edfbfd7961 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/Nullness/NullableReferenceTypesTests.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/Nullness/NullableReferenceTypesTests.fs @@ -17,6 +17,49 @@ let typeCheckWithStrictNullness cu = |> withNullnessOptions |> typecheck + + +[] +let ``Can convert generic value to objnull arg`` () = + FSharp """module TestLib + +let writeObj(tw:System.IO.TextWriter, a:'a) = + tw.Write(a) + +writeObj(System.IO.TextWriter.Null,null) + """ + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldSucceed + +[] +let ``Can pass nulll to objnull arg`` () = + FSharp """module TestLib +let doStuff args = + let ty = typeof + let m = ty.GetMethod("ToString") |> Unchecked.nonNull + m.Invoke(null,args) + """ + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldSucceed + +[] +let ``Can cast from objTy to interfaceTy`` () = + FSharp """module TestLib +open System +let safeHolder : IDisposable = + { new obj() with + override x.Finalize() = (x :?> IDisposable).Dispose() + interface IDisposable with + member x.Dispose() = + GC.SuppressFinalize x + } + """ + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldSucceed + [] let ``Does not duplicate warnings`` () = FSharp """ @@ -28,6 +71,66 @@ let getLength (x: string | null) = x.Length |> shouldFail |> withDiagnostics [Error 3261, Line 3, Col 36, Line 3, Col 44, "Nullness warning: The types 'string' and 'string | null' do not have compatible nullability."] +[] +let ``Does report warning on obj to static member`` () = + FSharp """ +type Test() = + member _.XX(o:obj) = () + static member X(o: obj) = () + static member XString(x:string) = () +let x: obj | null = null +Test.X x // warning expected +let y2 = Test.X(x) // warning also expected +Test.X(null:(obj|null)) // warning also expected +let t = Test() +t.XX(x) +Test.XString(null) +Test.XString("x":(string|null)) + """ + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldFail + |> withDiagnostics + [ Error 3261, Line 7, Col 8, Line 7, Col 9, "Nullness warning: The type 'obj | null' supports 'null' but a non-null type is expected." + Error 3261, Line 7, Col 1, Line 7, Col 9, "Nullness warning: The types 'obj' and 'obj | null' do not have compatible nullability." + Error 3261, Line 8, Col 17, Line 8, Col 18, "Nullness warning: The type 'obj | null' supports 'null' but a non-null type is expected." + Error 3261, Line 8, Col 10, Line 8, Col 19, "Nullness warning: The types 'obj' and 'obj | null' do not have compatible nullability." + Error 3261, Line 9, Col 8, Line 9, Col 23, "Nullness warning: The type 'obj | null' supports 'null' but a non-null type is expected." + Error 3261, Line 9, Col 1, Line 9, Col 24, "Nullness warning: The types 'obj' and 'obj | null' do not have compatible nullability." + Error 3261, Line 11, Col 6, Line 11, Col 7, "Nullness warning: The type 'obj | null' supports 'null' but a non-null type is expected." + Error 3261, Line 11, Col 1, Line 11, Col 8, "Nullness warning: The types 'obj' and 'obj | null' do not have compatible nullability." + Error 3261, Line 12, Col 14, Line 12, Col 18, "Nullness warning: The type 'string' does not support 'null'." + Error 3261, Line 13, Col 14, Line 13, Col 31, "Nullness warning: The types 'string' and 'string | null' do not have equivalent nullability."] + +[] +let ``Typar infered to nonnull obj`` () = + + FSharp """module Tests +let asObj(x:obj) = x +let asObjNull(x:objnull) = x + +let genericWithoutNull x = asObj x +let genericWithNull x = asObjNull x + +let result0 = genericWithoutNull null +let result1 = genericWithoutNull ("":(obj|null)) +let result2 = genericWithoutNull 15 +let result3 = genericWithoutNull "xxx" +let result4 = genericWithoutNull ("xxx":(string|null)) +let result5 = genericWithNull null +let result6 = genericWithNull 15 +let result7 = genericWithNull "xxx" +let result8 = genericWithNull ("":(obj|null)) + + """ + |> asLibrary + |> typeCheckWithStrictNullness + |> shouldFail + |> withDiagnostics + [ Error 43, Line 8, Col 34, Line 8, Col 38, "The constraints 'null' and 'not null' are inconsistent" + Error 3261, Line 9, Col 35, Line 9, Col 48, "Nullness warning: The type 'obj | null' supports 'null' but a non-null type is expected." + Error 3261, Line 12, Col 35, Line 12, Col 54, "Nullness warning: The type 'string | null' supports 'null' but a non-null type is expected."] + [] let ``Cannot pass possibly null value to a strict function``() = @@ -608,10 +711,16 @@ strictFunc("hi") |> ignore """ [] let ``Supports null in generic code`` () = FSharp """module MyLibrary -let myGenericFunction p = +let myGenericFunctionForInnerNotNull (p:_|null) = match p with | null -> () - | p -> printfn "%s" (p.ToString()) + | nnp -> printfn "%s" (nnp.ToString()) + +let myGenericFunctionSupportingNull (p) = + match p with + | null -> 0 + | nnp -> hash nnp + [] type X(p:int) = @@ -619,20 +728,15 @@ type X(p:int) = let myValOfX : X = null -myGenericFunction "HiThere" -myGenericFunction ("HiThere":string | null) -myGenericFunction (System.DateTime.Now) -myGenericFunction 123 -myGenericFunction myValOfX +myGenericFunctionForInnerNotNull "HiThere" +myGenericFunctionForInnerNotNull ("HiThere":string | null) +myGenericFunctionSupportingNull myValOfX |> ignore +myGenericFunctionSupportingNull ("HiThere":string | null) |> ignore """ |> asLibrary |> typeCheckWithStrictNullness - |> shouldFail - |> withDiagnostics - [Error 3261, Line 13, Col 19, Line 13, Col 28, "Nullness warning: The type 'string' does not support 'null'." - Error 193, Line 15, Col 20, Line 15, Col 39, "The type 'System.DateTime' does not have 'null' as a proper value" - Error 1, Line 16, Col 19, Line 16, Col 22, "The type 'int' does not have 'null' as a proper value"] + |> shouldSucceed [] let ``Null assignment in generic code`` () = diff --git a/tests/FSharp.Compiler.ComponentTests/Language/Nullness/using-nullness-syntax-positive.fs b/tests/FSharp.Compiler.ComponentTests/Language/Nullness/using-nullness-syntax-positive.fs index 2757ab30aea..69b554bd48f 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/Nullness/using-nullness-syntax-positive.fs +++ b/tests/FSharp.Compiler.ComponentTests/Language/Nullness/using-nullness-syntax-positive.fs @@ -120,9 +120,9 @@ System.Console.WriteLine("a") System.Console.WriteLine("a", (null: obj[])) // Expected to give a Nullness warning KonsoleWithNulls.WriteLine("Hello world") -KonsoleWithNulls.WriteLine(null) // WRONG: gives an incorrect Nullness warning for String | null and String | null +KonsoleWithNulls.WriteLine(null) KonsoleWithNulls.WriteLine("Hello","world") -KonsoleWithNulls.WriteLine("Hello","world","there") // // WRONG: gives an incorrect Nullness warning for String | null and String | null +KonsoleWithNulls.WriteLine("Hello","world","there") KonsoleNoNulls.WriteLine("Hello world") try @@ -169,7 +169,7 @@ with :? System.ArgumentNullException -> () // Param array cases KonsoleNoNulls.WriteLine("Hello","world","there") -KonsoleWithNulls.WriteLine("Hello","world",null) // Expected to give a Nullness warning +KonsoleWithNulls.WriteLine("Hello","world",null) // Expected to give no Nullness warning KonsoleNoNulls.WriteLine("Hello","world",null) // Expected to give a Nullness warning System.Console.WriteLine("a", (null: obj[] | null)) System.Console.WriteLine("a", (null: (obj | null)[] | null)) diff --git a/tests/FSharp.Compiler.ComponentTests/Language/Nullness/using-nullness-syntax-positive.fs.checknulls_on.err.bsl b/tests/FSharp.Compiler.ComponentTests/Language/Nullness/using-nullness-syntax-positive.fs.checknulls_on.err.bsl index 5154ce43e79..709c3c309b3 100644 --- a/tests/FSharp.Compiler.ComponentTests/Language/Nullness/using-nullness-syntax-positive.fs.checknulls_on.err.bsl +++ b/tests/FSharp.Compiler.ComponentTests/Language/Nullness/using-nullness-syntax-positive.fs.checknulls_on.err.bsl @@ -31,5 +31,6 @@ using-nullness-syntax-positive.fs (154,40)-(154,44) typecheck error Nullness war using-nullness-syntax-positive.fs (159,36)-(159,40) typecheck error Nullness warning: The type 'String' does not support 'null'. using-nullness-syntax-positive.fs (162,41)-(162,45) typecheck error Nullness warning: The type 'String' does not support 'null'. using-nullness-syntax-positive.fs (164,37)-(164,41) typecheck error Nullness warning: The type 'String' does not support 'null'. +using-nullness-syntax-positive.fs (173,42)-(173,46) typecheck error The constraints 'null' and 'not null' are inconsistent using-nullness-syntax-positive.fs (183,14)-(183,16) typecheck error Nullness warning: The type 'string' does not support 'null'. using-nullness-syntax-positive.fs (189,17)-(189,26) typecheck error Nullness warning: The type 'String' does not support 'null'. \ No newline at end of file diff --git a/tests/fsharp/core/libtest/test.fsx b/tests/fsharp/core/libtest/test.fsx index 6df6e6e4432..fae232ae5e9 100644 --- a/tests/fsharp/core/libtest/test.fsx +++ b/tests/fsharp/core/libtest/test.fsx @@ -559,9 +559,9 @@ do test "cwewvewho0" (match box(Some 3) with :? option -> false | _ - do test "cwewvewho-" (match box([3]) with :? list as v -> (v = [3]) | _ -> false) do test "cwewvewhoa" (match box([3]) with :? list as v -> false | _ -> true) -do test "cwewvewhos" (match (null:obj) with :? list as v -> false | _ -> true) +do test "cwewvewhos" (match (null:obj) with :? list as v -> false | _ -> true) -let pattest<'a> (obj:obj) fail (succeed : 'a -> bool) = match obj with :? 'a as x -> succeed x | _ -> fail() +let pattest<'a> (obj:objnull) fail (succeed : 'a -> bool) = match obj with :? 'a as x -> succeed x | _ -> fail() do test "cwewvewhoq" (pattest (box(1)) (fun () -> false) (fun v -> v = 1)) do test "cwewvewhow" (pattest (null) (fun () -> true ) (fun _ -> false)) diff --git a/tests/fsharp/core/subtype/test.fsx b/tests/fsharp/core/subtype/test.fsx index 820c8566502..c813ee3ff3a 100644 --- a/tests/fsharp/core/subtype/test.fsx +++ b/tests/fsharp/core/subtype/test.fsx @@ -1768,7 +1768,7 @@ module GenericPropertyConstraintSolvedByRecord = /// overload, even before the full signature of the trait constraint was known. module MethodOverloadingForTraitConstraintsIsNotDeterminedUntilSignatureIsKnown = type X = - static member Method (a: obj) = 1 + static member Method (a: objnull) = 1 static member Method (a: int) = 2 static member Method (a: int64) = 3 @@ -2339,7 +2339,7 @@ module TestSubtypeMatching11 = [] type E() = inherit A() - let toName (x: obj * obj) = + let toName (x: objnull * objnull) = match x with | null, :? E -> "0E" | (:? A), :? E -> "AE" @@ -2418,7 +2418,7 @@ module TestSubtypeMatching12 = type C() = interface IC - let toName (x: obj) = + let toName (x: objnull) = match x with | null -> "null" | :? IA when false -> "IA fail" @@ -2444,7 +2444,7 @@ module TestSubtypeMatching13 = type C() = interface IC - let toName (x: obj) = + let toName (x: objnull) = match x with | null when false -> "null" | :? IA -> "IA"