From 6b4221a73b50c1d91c111e13419111d91a483f03 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 26 May 2023 11:26:43 +0100 Subject: [PATCH 1/6] enablement --- FSharp.Profiles.props | 5 +++-- src/Compiler/FSharp.Compiler.Service.fsproj | 1 - src/FSharp.Build/FSharp.Build.fsproj | 1 - 3 files changed, 3 insertions(+), 4 deletions(-) diff --git a/FSharp.Profiles.props b/FSharp.Profiles.props index d477f570f34..55c5cdea141 100644 --- a/FSharp.Profiles.props +++ b/FSharp.Profiles.props @@ -2,8 +2,8 @@ - - false + + true @@ -12,6 +12,7 @@ + false BUILDING_WITH_LKG;NO_NULLCHECKING_LIB_SUPPORT;$(DefineConstants) false diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index af5e504d33c..a5648ed457f 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -13,7 +13,6 @@ FSharp.Compiler.Service true $(DefineConstants);COMPILER - true $(DefineConstants);FSHARPCORE_USE_PACKAGE $(OtherFlags) --extraoptimizationloops:1 diff --git a/src/FSharp.Build/FSharp.Build.fsproj b/src/FSharp.Build/FSharp.Build.fsproj index a159fb8d43b..f8fbc7138ef 100644 --- a/src/FSharp.Build/FSharp.Build.fsproj +++ b/src/FSharp.Build/FSharp.Build.fsproj @@ -9,7 +9,6 @@ FSharp.Build $(NoWarn);75 true - true $(DefineConstants);LOCALIZATION_FSBUILD $(NoWarn);NU1701;FS0075 true From c27947df8262227c9be7b3c1760976de2e44855d Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 26 May 2023 11:29:52 +0100 Subject: [PATCH 2/6] enablement --- FSharp.Profiles.props | 3 ++- src/Compiler/FSharp.Compiler.Service.fsproj | 1 + src/FSharp.Build/FSharp.Build.fsproj | 1 + 3 files changed, 4 insertions(+), 1 deletion(-) diff --git a/FSharp.Profiles.props b/FSharp.Profiles.props index 55c5cdea141..3c7457dcb83 100644 --- a/FSharp.Profiles.props +++ b/FSharp.Profiles.props @@ -3,7 +3,8 @@ - true + + false diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index a5648ed457f..af5e504d33c 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -13,6 +13,7 @@ FSharp.Compiler.Service true $(DefineConstants);COMPILER + true $(DefineConstants);FSHARPCORE_USE_PACKAGE $(OtherFlags) --extraoptimizationloops:1 diff --git a/src/FSharp.Build/FSharp.Build.fsproj b/src/FSharp.Build/FSharp.Build.fsproj index f8fbc7138ef..a159fb8d43b 100644 --- a/src/FSharp.Build/FSharp.Build.fsproj +++ b/src/FSharp.Build/FSharp.Build.fsproj @@ -9,6 +9,7 @@ FSharp.Build $(NoWarn);75 true + true $(DefineConstants);LOCALIZATION_FSBUILD $(NoWarn);NU1701;FS0075 true From b8a0ad2f85c75f8e03271a3fa881bd6a2584cd8a Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 26 May 2023 11:59:16 +0100 Subject: [PATCH 3/6] fix build --- src/Compiler/TypedTree/TypeProviders.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Compiler/TypedTree/TypeProviders.fs b/src/Compiler/TypedTree/TypeProviders.fs index fbb1899bcd1..34eefe3d3e4 100644 --- a/src/Compiler/TypedTree/TypeProviders.fs +++ b/src/Compiler/TypedTree/TypeProviders.fs @@ -1122,7 +1122,7 @@ let ValidateExpectedName m expectedPath expectedName (st: Tainted) #if NO_CHECKNULLS let namespaceName = TryTypeMember(st, name, "Namespace", m, "", fun st -> st.Namespace) |> unmarshal #else - let namespaceName = TryTypeMember<_, string?>(st, name, "Namespace", m, "", fun st -> st.Namespace) |> unmarshal // TODO NULLNESS: why is this explicit instantiation needed? + let namespaceName = TryTypeMember<_, string __withnull>(st, name, "Namespace", m, "", fun st -> st.Namespace) |> unmarshal // TODO NULLNESS: why is this explicit instantiation needed? #endif let rec declaringTypes (st: Tainted) accu = @@ -1149,7 +1149,7 @@ let ValidateProvidedTypeAfterStaticInstantiation(m, st: Tainted, e #if NO_CHECKNULLS let namespaceName = TryTypeMember(st, name, "Namespace", m, FSComp.SR.invalidNamespaceForProvidedType(), fun st -> st.Namespace) |> unmarshal #else - let namespaceName = TryTypeMember<_, string?>(st, name, "Namespace", m, FSComp.SR.invalidNamespaceForProvidedType(), fun st -> st.Namespace) |> unmarshal + let namespaceName = TryTypeMember<_, string __withnull>(st, name, "Namespace", m, FSComp.SR.invalidNamespaceForProvidedType(), fun st -> st.Namespace) |> unmarshal #endif let fullName = TryTypeMemberNonNull(st, name, "FullName", m, FSComp.SR.invalidFullNameForProvidedType(), fun st -> st.FullName) |> unmarshal ValidateExpectedName m expectedPath expectedName st @@ -1258,7 +1258,7 @@ let ValidateProvidedTypeDefinition(m, st: Tainted, expectedPath: s #if NO_CHECKNULLS let _namespaceName = TryTypeMember(st, name, "Namespace", m, FSComp.SR.invalidNamespaceForProvidedType(), fun st -> st.Namespace) |> unmarshal #else - let _namespaceName = TryTypeMember<_, (string?)>(st, name, "Namespace", m, FSComp.SR.invalidNamespaceForProvidedType(), fun st -> st.Namespace) |> unmarshal + let _namespaceName = TryTypeMember<_, string __withnull>(st, name, "Namespace", m, FSComp.SR.invalidNamespaceForProvidedType(), fun st -> st.Namespace) |> unmarshal #endif let _fullname = TryTypeMemberNonNull(st, name, "FullName", m, FSComp.SR.invalidFullNameForProvidedType(), fun st -> st.FullName) |> unmarshal ValidateExpectedName m expectedPath expectedName st From 64bf5a019467a8268d437b0a5e01d214d9be860b Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 26 May 2023 14:11:49 +0100 Subject: [PATCH 4/6] fix build --- FSharp.Profiles.props | 2 +- src/Compiler/Checking/ConstraintSolver.fs | 28 ++++++++++--------- src/Compiler/Checking/NicePrint.fs | 23 ++++++++++++---- src/Compiler/Driver/CompilerDiagnostics.fs | 9 +++++++ src/Compiler/Interactive/fsi.fs | 8 +++--- src/Compiler/Symbols/SymbolHelpers.fs | 2 +- src/Compiler/TypedTree/TcGlobals.fs | 5 ++++ src/Compiler/TypedTree/TypedTreeOps.fs | 31 ++++++++++++++++------ src/Compiler/TypedTree/TypedTreeOps.fsi | 2 +- src/Compiler/Utilities/illib.fs | 10 +++---- 10 files changed, 81 insertions(+), 39 deletions(-) diff --git a/FSharp.Profiles.props b/FSharp.Profiles.props index 3c7457dcb83..dbbe1903539 100644 --- a/FSharp.Profiles.props +++ b/FSharp.Profiles.props @@ -14,7 +14,7 @@ false - BUILDING_WITH_LKG;NO_NULLCHECKING_LIB_SUPPORT;$(DefineConstants) + NO_CHECKNULLS;BUILDING_WITH_LKG;NO_NULLCHECKING_LIB_SUPPORT;$(DefineConstants) false diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index a76c6bb1d11..7e1bd3b3f05 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -1294,19 +1294,19 @@ and SolveTypeEqualsType (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr ) // Catch float<_>=float<1>, float32<_>=float32<1> and decimal<_>=decimal<1> - | (_, TType_app (tc2, [ms2], nullness2)) when (tc2.IsMeasureableReprTycon && typeEquiv csenv.g sty1 (reduceTyconRefMeasureableOrProvided csenv.g tc2 [ms2])) -> + | (_, TType_app (tc2, [ms2], _)) when (tc2.IsMeasureableReprTycon && typeEquiv csenv.g sty1 (reduceTyconRefMeasureableOrProvided csenv.g tc2 [ms2])) -> SolveTypeEqualsType csenv ndeep m2 trace None (TType_measure Measure.One) ms2 ++ (fun () -> - SolveNullnessEquiv csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) nullness2 + SolveNullnessEquiv csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2) ) - | (TType_app (tc1, [ms1], nullness1), _) when (tc1.IsMeasureableReprTycon && typeEquiv csenv.g sty2 (reduceTyconRefMeasureableOrProvided csenv.g tc1 [ms1])) -> + | (TType_app (tc1, [ms1], _), _) when (tc1.IsMeasureableReprTycon && typeEquiv csenv.g sty2 (reduceTyconRefMeasureableOrProvided csenv.g tc1 [ms1])) -> SolveTypeEqualsType csenv ndeep m2 trace None ms1 (TType_measure Measure.One) ++ (fun () -> - SolveNullnessEquiv csenv m2 trace ty1 ty2 nullness1 (nullnessOfTy g sty2) + SolveNullnessEquiv csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2) ) - | TType_app (tc1, l1, nullness1), TType_app (tc2, l2, nullness2) when tyconRefEq g tc1 tc2 -> + | TType_app (tc1, l1, _), TType_app (tc2, l2, _) when tyconRefEq g tc1 tc2 -> SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2 ++ (fun () -> - SolveNullnessEquiv csenv m2 trace ty1 ty2 nullness1 nullness2 + SolveNullnessEquiv csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2) ) | TType_app _, TType_app _ -> @@ -1429,14 +1429,14 @@ and SolveTypeSubsumesType (csenv: ConstraintSolverEnv) ndeep m2 (trace: Optional UnifyMeasures csenv trace ms1 ms2 // Enforce the identities float=float<1>, float32=float32<1> and decimal=decimal<1> - | _, TType_app (tc2, [ms2], nullness2) when tc2.IsMeasureableReprTycon && typeEquiv csenv.g sty1 (reduceTyconRefMeasureableOrProvided csenv.g tc2 [ms2]) -> + | _, TType_app (tc2, [ms2], _) when tc2.IsMeasureableReprTycon && typeEquiv csenv.g sty1 (reduceTyconRefMeasureableOrProvided csenv.g tc2 [ms2]) -> SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln ms2 (TType_measure Measure.One) ++ (fun () -> - SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) nullness2 + SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2) ) - | TType_app (tc1, [ms1], nullness1), _ when tc1.IsMeasureableReprTycon && typeEquiv csenv.g sty2 (reduceTyconRefMeasureableOrProvided csenv.g tc1 [ms1]) -> + | TType_app (tc1, [ms1], _), _ when tc1.IsMeasureableReprTycon && typeEquiv csenv.g sty2 (reduceTyconRefMeasureableOrProvided csenv.g tc1 [ms1]) -> SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln ms1 (TType_measure Measure.One) ++ (fun () -> - SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 nullness1 (nullnessOfTy g sty2) + SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 (nullnessOfTy g sty1) (nullnessOfTy g sty2) ) // Special subsumption rule for byref tags @@ -1452,9 +1452,9 @@ and SolveTypeSubsumesType (csenv: ConstraintSolverEnv) ndeep m2 (trace: Optional } | _ -> SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln l1 l2 - | TType_app (tc1, l1, nullness1) , TType_app (tc2, l2, nullness2) when tyconRefEq g tc1 tc2 -> + | TType_app (tc1, l1, _) , TType_app (tc2, l2, _) when tyconRefEq g tc1 tc2 -> SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln l1 l2 ++ (fun () -> - SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 nullness1 nullness2 + 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 -> @@ -2551,7 +2551,8 @@ and SolveTypeUseNotSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 trace ty = // code via Option.ofObj and Option.toObj do! WarnD (ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsTrueValue(NicePrint.minimalStringOfType denv ty), m, m2)) elif TypeNullIsExtraValueNew g m ty then - if g.checkNullness && not (isObjTy g ty) then + if g.checkNullness && not (isObjTy g ty) then + let denv = { denv with showNullnessAnnotations = Some true } do! WarnD (ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsExtraValue(NicePrint.minimalStringOfType denv ty), m, m2)) else match tryDestTyparTy g ty with @@ -2578,6 +2579,7 @@ and SolveNullnessNotSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 (trace: O | NullnessInfo.WithoutNull -> () | NullnessInfo.WithNull -> if g.checkNullness && TypeNullIsExtraValueNew g m ty && not (isObjTy g ty) then + let denv = { denv with showNullnessAnnotations = Some true } return! WarnD(ConstraintSolverNullnessWarning(FSComp.SR.csTypeHasNullAsExtraValue(NicePrint.minimalStringOfType denv ty), m, m2)) } diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index 7412023285c..6ff67cf9d63 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -320,6 +320,13 @@ module internal PrintUtilities = | Some w -> Display.squashTo w layout | None -> layout + // When showing types in diagnostics, we don't show nullness annotations by default + // unless the diagnostic is specifically about nullness. + let suppressNullnessAnnotations denv = + match denv.showNullnessAnnotations with + | None -> { denv with showNullnessAnnotations = Some false } + | _ -> denv + module PrintIL = let fullySplitILTypeRef (tref: ILTypeRef) = @@ -879,7 +886,8 @@ module PrintTypes = | args -> bracketIfL (prec <= 1) (bracketL (layoutTypesWithInfoAndPrec denv env 2 (sepL (tagPunctuation ",")) args) --- tcL) and layoutNullness (denv: DisplayEnv) part2 (nullness: Nullness) = - if denv.showNullnessAnnotations then + // Show nullness annotations unless explicitly turned off + if denv.showNullnessAnnotations <> Some false then match nullness.Evaluate() with | NullnessInfo.WithNull -> part2 ^^ wordL (tagText "__withnull") | NullnessInfo.WithoutNull -> part2 @@ -1227,6 +1235,7 @@ module PrintTastMemberOrVals = nameL let prettyLayoutOfMemberShortOption denv typarInst (v: Val) short = + let denv = suppressNullnessAnnotations denv let vref = mkLocalValRef v let membInfo = Option.get vref.MemberInfo let stat = layoutMemberFlags membInfo.MemberFlags @@ -2658,9 +2667,11 @@ let prettyLayoutOfInstAndSig denv x = PrintTypes.prettyLayoutOfInstAndSig denv x let minimalStringsOfTwoTypes denv ty1 ty2 = let (ty1, ty2), tpcs = PrettyTypes.PrettifyTypePair denv.g (ty1, ty2) + let denv = suppressNullnessAnnotations denv + // try denv + no type annotations let attempt1 = - let denv = { denv with showInferenceTyparAnnotations=false; showStaticallyResolvedTyparAnnotations=false; showNullnessAnnotations=false } + let denv = { denv with showInferenceTyparAnnotations=false; showStaticallyResolvedTyparAnnotations=false } let min1 = stringOfTy denv ty1 let min2 = stringOfTy denv ty2 if min1 <> min2 then Some (min1, min2, "") else None @@ -2671,7 +2682,7 @@ let minimalStringsOfTwoTypes denv ty1 ty2 = // try denv + no type annotations + show full paths let attempt2 = - let denv = { denv with showInferenceTyparAnnotations=false; showStaticallyResolvedTyparAnnotations=false; showNullnessAnnotations=false }.SetOpenPaths [] + let denv = { denv with showInferenceTyparAnnotations=false; showStaticallyResolvedTyparAnnotations=false }.SetOpenPaths [] let min1 = stringOfTy denv ty1 let min2 = stringOfTy denv ty2 if min1 <> min2 then Some (min1, min2, "") else None @@ -2713,18 +2724,20 @@ let minimalStringsOfTwoTypes denv ty1 ty2 = // Note: Always show imperative annotations when comparing value signatures let minimalStringsOfTwoValues denv infoReader vref1 vref2 = - let denvMin = { denv with showInferenceTyparAnnotations=true; showStaticallyResolvedTyparAnnotations=false; showNullnessAnnotations=false } + let denv = suppressNullnessAnnotations denv + let denvMin = { denv with showInferenceTyparAnnotations=true; showStaticallyResolvedTyparAnnotations=false } let min1 = buildString (fun buf -> outputQualifiedValOrMember denvMin infoReader buf vref1) let min2 = buildString (fun buf -> outputQualifiedValOrMember denvMin infoReader buf vref2) if min1 <> min2 then (min1, min2) else - let denvMax = { denv with showInferenceTyparAnnotations=true; showStaticallyResolvedTyparAnnotations=true; showNullnessAnnotations=false } + let denvMax = { denv with showInferenceTyparAnnotations=true; showStaticallyResolvedTyparAnnotations=true } let max1 = buildString (fun buf -> outputQualifiedValOrMember denvMax infoReader buf vref1) let max2 = buildString (fun buf -> outputQualifiedValOrMember denvMax infoReader buf vref2) max1, max2 let minimalStringOfType denv ty = let ty, _cxs = PrettyTypes.PrettifyType denv.g ty + let denv = suppressNullnessAnnotations denv let denvMin = { denv with showInferenceTyparAnnotations=false; showStaticallyResolvedTyparAnnotations=false } showL (PrintTypes.layoutTypeWithInfoAndPrec denvMin SimplifyTypes.typeSimplificationInfo0 2 ty) diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 6c6c64d4a20..ca8ff57c0f8 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -678,6 +678,9 @@ type Exception with | ConstraintSolverNullnessWarningEquivWithTypes (denv, ty1, ty2, _nullness1, _nullness2, m, m2) -> + // Turn on nullness annotations for messages about nullness + let denv = { denv with showNullnessAnnotations = Some true } + let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 os.Append(ConstraintSolverNullnessWarningEquivWithTypesE().Format t1 t2) @@ -688,6 +691,9 @@ type Exception with | ConstraintSolverNullnessWarningWithTypes (denv, ty1, ty2, _nullness1, _nullness2, m, m2) -> + // Turn on nullness annotations for messages about nullness + let denv = { denv with showNullnessAnnotations = Some true } + let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 os.Append(ConstraintSolverNullnessWarningWithTypesE().Format t1 t2) |> ignore @@ -697,6 +703,9 @@ type Exception with | ConstraintSolverNullnessWarningWithType (denv, ty, _, m, m2) -> + // Turn on nullness annotations for messages about nullness + let denv = { denv with showNullnessAnnotations = Some true } + let t = NicePrint.minimalStringOfType denv ty os.Append(ConstraintSolverNullnessWarningWithTypeE().Format(t)) |> ignore diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 97c3cc08d84..605981c6361 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -3439,7 +3439,7 @@ type internal MagicAssemblyResolution() = fsiDynamicCompiler: FsiDynamicCompiler, fsiConsoleOutput: FsiConsoleOutput, fullAssemName: string - ) = + ) : Assembly MaybeNull = //Eliminate recursive calls to Resolve which can happen via our callout to msbuild resolution if MagicAssemblyResolution.resolving then @@ -3527,14 +3527,14 @@ type FsiStdinLexerProvider | NonNull t -> fsiStdinSyphon.Add(t + "\n")) match inputOption with - | Some null + | Some Null | None -> if progress then fprintfn fsiConsoleOutput.Out "End of file from TextReader.ReadLine" 0 - | Some (input: string) -> - let input = input + "\n" + | Some (NonNull input) -> + let input = nonNull input + "\n" if input.Length > len then fprintf fsiConsoleOutput.Error "%s" (FSIstrings.SR.fsiLineTooLong ()) diff --git a/src/Compiler/Symbols/SymbolHelpers.fs b/src/Compiler/Symbols/SymbolHelpers.fs index 11a9623bff1..9ac979fa9da 100644 --- a/src/Compiler/Symbols/SymbolHelpers.fs +++ b/src/Compiler/Symbols/SymbolHelpers.fs @@ -543,7 +543,7 @@ module internal SymbolHelpers = let SimplerDisplayEnv denv = { denv with shortConstraints=true showStaticallyResolvedTyparAnnotations=false - showNullnessAnnotations=false + showNullnessAnnotations = Some false abbreviateAdditionalConstraints=false suppressNestedTypes=true maxMembers=Some EnvMisc2.maxMembers } diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 3f92f88a3e6..4820483d675 100755 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -196,6 +196,9 @@ type TcGlobals( let v_langFeatureNullness = langVersion.SupportsFeature LanguageFeature.NullnessChecking + let v_knownWithNull = + if v_langFeatureNullness then KnownWithNull else KnownAmbivalentToNull + let v_knownWithoutNull = if v_langFeatureNullness then KnownWithoutNull else KnownAmbivalentToNull @@ -1091,6 +1094,8 @@ type TcGlobals( member _.langFeatureNullness = v_langFeatureNullness + member _.knownWithNull = v_knownWithNull + member _.knownWithoutNull = v_knownWithoutNull // A table of known modules in FSharp.Core. Not all modules are necessarily listed, but the more we list the diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index d884826c2e2..b2d86d3285c 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -863,8 +863,6 @@ let destAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, tinst, _) let tcrefOfAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _, _) -> tcref | _ -> failwith "tcrefOfAppTy") -let nullnessOfTy g ty = ty |> stripTyEqns g |> (function TType_app(_, _, nullness) | TType_fun (_, _, nullness) | TType_var (_, nullness) -> nullness | _ -> g.knownWithoutNull) - let argsOfAppTy g ty = ty |> stripTyEqns g |> (function TType_app(_, tinst, _) -> tinst | _ -> []) let tryDestTyparTy g ty = ty |> stripTyEqns g |> (function TType_var (v, _) -> ValueSome v | _ -> ValueNone) @@ -3078,7 +3076,7 @@ type DisplayEnv = showAttributes: bool showOverrides: bool showStaticallyResolvedTyparAnnotations: bool - showNullnessAnnotations: bool + showNullnessAnnotations: bool option abbreviateAdditionalConstraints: bool showTyparDefaultConstraints: bool showDocumentation: bool @@ -3113,7 +3111,7 @@ type DisplayEnv = showAttributes = false showOverrides = true showStaticallyResolvedTyparAnnotations = true - showNullnessAnnotations = true + showNullnessAnnotations = None showDocumentation = false abbreviateAdditionalConstraints = false showTyparDefaultConstraints = false @@ -8906,16 +8904,16 @@ let TypeNullNever g ty = isByrefTy g underlyingTy || isNonNullableStructTyparTy g ty -/// The F# 4.5 logic about whether a type admits the use of 'null' as a value. +/// The pre-nullness logic about whether a type admits the use of 'null' as a value. let TypeNullIsExtraValue g m ty = if isILReferenceTy g ty || isDelegateTy g ty then match tryTcrefOfAppTy g ty with | ValueSome tcref -> - // In F# 4.x, putting AllowNullLiteralAttribute(false) on an IL or provided + // Putting AllowNullLiteralAttribute(false) on an IL or provided // type means 'null' can't be used with that type, otherwise it can TryFindTyconRefBoolAttribute g m g.attrib_AllowNullLiteralAttribute tcref <> Some false | _ -> - // In F# 4.5, other IL reference types (e.g. arrays) always support null + // In pre-nullness, other IL reference types (e.g. arrays) always support null true elif TypeNullNever g ty then false @@ -8928,6 +8926,23 @@ let TypeNullIsExtraValue g m ty = // Consider type parameters isSupportsNullTyparTy g ty +// Any mention of a type with AllowNullLiteral(true) is considered to be with-null +let intrinsicNullnessOfTyconRef g (tcref: TyconRef) = + match TryFindTyconRefBoolAttribute g tcref.Range g.attrib_AllowNullLiteralAttribute tcref with + | Some true -> g.knownWithNull + | _ -> g.knownWithoutNull + +let nullnessOfTy g ty = + ty + |> stripTyEqns g + |> function + | TType_app(tcref, _, nullness) -> + let nullness2 = intrinsicNullnessOfTyconRef g tcref + combineNullness nullness nullness2 + | TType_fun (_, _, nullness) | TType_var (_, nullness) -> + nullness + | _ -> g.knownWithoutNull + /// The new logic about whether a type admits the use of 'null' as a value. let TypeNullIsExtraValueNew g m ty = let sty = stripTyparEqns ty @@ -8952,7 +8967,7 @@ let TypeNullIsExtraValueNew g m ty = // Check if the type has a ': null' constraint isSupportsNullTyparTy g ty -/// The F# 4.5 and 5.0 logic about whether a type uses 'null' as a true representation value +/// The pre-nullness logic about whether a type uses 'null' as a true representation value let TypeNullIsTrueValue g ty = (match tryTcrefOfAppTy g ty with | ValueSome tcref -> IsUnionTypeWithNullAsTrueValue g tcref.Deref diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index db8d887358a..a7ae81fb761 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -1061,7 +1061,7 @@ type DisplayEnv = showAttributes: bool showOverrides: bool showStaticallyResolvedTyparAnnotations: bool - showNullnessAnnotations: bool + showNullnessAnnotations: bool option abbreviateAdditionalConstraints: bool showTyparDefaultConstraints: bool /// If set, signatures will be rendered with XML documentation comments for members if they exist diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index 7942b78593e..699c9a2908b 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -90,17 +90,15 @@ module internal PervasiveAutoOpens = | Some x -> x let reportTime = - let mutable tPrev: IDisposable = null + let mutable tPrev: IDisposable MaybeNull = null fun descr -> if isNotNull tPrev then tPrev.Dispose() + tPrev <- null - tPrev <- - if descr <> "Finish" then - FSharp.Compiler.Diagnostics.Activity.Profiling.startAndMeasureEnvironmentStats descr - else - null + if descr <> "Finish" then + tPrev <- FSharp.Compiler.Diagnostics.Activity.Profiling.startAndMeasureEnvironmentStats descr let foldOn p f z x = f z (p x) From dec555c4ea446dbf1406b4812f87428d183f1f58 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 26 May 2023 14:19:39 +0100 Subject: [PATCH 5/6] fantomas --- src/Compiler/Driver/CompilerDiagnostics.fs | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index ca8ff57c0f8..e938263699b 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -679,7 +679,10 @@ type Exception with | ConstraintSolverNullnessWarningEquivWithTypes (denv, ty1, ty2, _nullness1, _nullness2, m, m2) -> // Turn on nullness annotations for messages about nullness - let denv = { denv with showNullnessAnnotations = Some true } + let denv = + { denv with + showNullnessAnnotations = Some true + } let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 @@ -692,7 +695,10 @@ type Exception with | ConstraintSolverNullnessWarningWithTypes (denv, ty1, ty2, _nullness1, _nullness2, m, m2) -> // Turn on nullness annotations for messages about nullness - let denv = { denv with showNullnessAnnotations = Some true } + let denv = + { denv with + showNullnessAnnotations = Some true + } let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 @@ -704,7 +710,10 @@ type Exception with | ConstraintSolverNullnessWarningWithType (denv, ty, _, m, m2) -> // Turn on nullness annotations for messages about nullness - let denv = { denv with showNullnessAnnotations = Some true } + let denv = + { denv with + showNullnessAnnotations = Some true + } let t = NicePrint.minimalStringOfType denv ty os.Append(ConstraintSolverNullnessWarningWithTypeE().Format(t)) |> ignore From 342a5612def7ad94f7599a9d1e983e186020fbc8 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Fri, 26 May 2023 15:09:57 +0100 Subject: [PATCH 6/6] selective adoption --- src/Compiler/FSharp.Compiler.Service.fsproj | 1 + src/FSharp.Build/FSharp.Build.fsproj | 1 + 2 files changed, 2 insertions(+) diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index a5648ed457f..af5e504d33c 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -13,6 +13,7 @@ FSharp.Compiler.Service true $(DefineConstants);COMPILER + true $(DefineConstants);FSHARPCORE_USE_PACKAGE $(OtherFlags) --extraoptimizationloops:1 diff --git a/src/FSharp.Build/FSharp.Build.fsproj b/src/FSharp.Build/FSharp.Build.fsproj index f8fbc7138ef..a159fb8d43b 100644 --- a/src/FSharp.Build/FSharp.Build.fsproj +++ b/src/FSharp.Build/FSharp.Build.fsproj @@ -9,6 +9,7 @@ FSharp.Build $(NoWarn);75 true + true $(DefineConstants);LOCALIZATION_FSBUILD $(NoWarn);NU1701;FS0075 true