squash

dotnet · May 24, 2023 · 2e8ab38 · 2e8ab38
1 parent 635d723
commit 2e8ab38
Show file tree

Hide file tree

Showing 119 changed files with 3,722 additions and 682 deletions.
diff --git a/.fantomasignore b/.fantomasignore
@@ -90,6 +90,23 @@ src/FSharp.Core/Query.fs
 src/FSharp.Core/seqcore.fs
 
 
+# fsharp  (to investigate)
+
+**/TypeProviders.fsi
+**/tainted.fsi
+
+# uses nullness features
+
+**/DependencyProvider.fsi
+src/FSharp.Core/array.fs
+src/FSharp.Core/option.fsi
+src/FSharp.Core/option.fs
+src/fsi/console.fs
+src/FSharp.Build/FSharpCommandLineBuilder.fs
+src/Compiler/Utilities/sformat.fs
+src/Compiler/Utilities/illib.fsi
+src/Compiler/Utilities/illib.fs
+
 # Fantomas limitations on implementation files  (to investigate)
 
 src/Compiler/AbstractIL/ilwrite.fs

diff --git a/FSharp.Profiles.props b/FSharp.Profiles.props
@@ -1,6 +1,34 @@
 <?xml version="1.0" encoding="utf-8"?>
 <!-- Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information. -->
 <Project>
+  <PropertyGroup>
+    <!-- This turns on/off the feature in FSharp.Core. -->
+    <CheckNulls>false</CheckNulls>
+  </PropertyGroup>
+
+  <PropertyGroup Condition="'$(FSHARPCORE_USE_PACKAGE)' == 'true'">
+    <!-- nullness checking isn't possible when using shipped FSharp.Core package until it's updated -->
+    <CheckNulls>false</CheckNulls>
+  </PropertyGroup>
+
+  <PropertyGroup Condition="'$(Configuration)' == 'Proto'">
+    <DefineConstants>BUILDING_WITH_LKG;NO_NULLCHECKING_LIB_SUPPORT;$(DefineConstants)</DefineConstants>
+    <NullCheckingSupportInLibrary>false</NullCheckingSupportInLibrary>
+  </PropertyGroup>
+
+  <PropertyGroup Condition="'$(Configuration)' != 'Proto'">
+    <OtherFlags>$(OtherFlags) /langversion:preview</OtherFlags>
+  </PropertyGroup>
+
+  <PropertyGroup Condition="'$(CheckNulls)' == 'true'">
+    <OtherFlags>$(OtherFlags) /checknulls</OtherFlags>
+  </PropertyGroup>
+
+  <PropertyGroup Condition="'$(CheckNulls)' == 'false'">
+    <!-- 3271: warning nullness annotations being ignored -->
+    <NoWarn>$(NoWarn);3271</NoWarn>
+    <DefineConstants>NO_CHECKNULLS;$(DefineConstants)</DefineConstants>
+  </PropertyGroup>
 
   <Choose>
     <When Condition=" '$(TargetFrameworkIdentifier)' == '.NETFramework' ">

diff --git a/VisualFSharp.sln b/VisualFSharp.sln
@@ -195,6 +195,8 @@ Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "FSharp.Editor.Tests", "vsin
 EndProject
 Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "FSharp.Editor.IntegrationTests", "vsintegration\tests\FSharp.Editor.IntegrationTests\FSharp.Editor.IntegrationTests.csproj", "{E31F9B59-FCF1-4D04-8762-C7BB60285A7B}"
 EndProject
+Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "nullness", "tests\fsharp\core\nullness\nullness.fsproj", "{6992D926-AB1C-4CD4-94D5-0319D14DB54B}"
+EndProject
 Global
 	GlobalSection(SolutionConfigurationPlatforms) = preSolution
 		Debug|Any CPU = Debug|Any CPU
@@ -1033,6 +1035,18 @@ Global
 		{E31F9B59-FCF1-4D04-8762-C7BB60285A7B}.Release|Any CPU.Build.0 = Release|Any CPU
 		{E31F9B59-FCF1-4D04-8762-C7BB60285A7B}.Release|x86.ActiveCfg = Release|Any CPU
 		{E31F9B59-FCF1-4D04-8762-C7BB60285A7B}.Release|x86.Build.0 = Release|Any CPU
+		{6992D926-AB1C-4CD4-94D5-0319D14DB54B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{6992D926-AB1C-4CD4-94D5-0319D14DB54B}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{6992D926-AB1C-4CD4-94D5-0319D14DB54B}.Debug|x86.ActiveCfg = Debug|Any CPU
+		{6992D926-AB1C-4CD4-94D5-0319D14DB54B}.Debug|x86.Build.0 = Debug|Any CPU
+		{6992D926-AB1C-4CD4-94D5-0319D14DB54B}.Proto|Any CPU.ActiveCfg = Debug|Any CPU
+		{6992D926-AB1C-4CD4-94D5-0319D14DB54B}.Proto|Any CPU.Build.0 = Debug|Any CPU
+		{6992D926-AB1C-4CD4-94D5-0319D14DB54B}.Proto|x86.ActiveCfg = Debug|Any CPU
+		{6992D926-AB1C-4CD4-94D5-0319D14DB54B}.Proto|x86.Build.0 = Debug|Any CPU
+		{6992D926-AB1C-4CD4-94D5-0319D14DB54B}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{6992D926-AB1C-4CD4-94D5-0319D14DB54B}.Release|Any CPU.Build.0 = Release|Any CPU
+		{6992D926-AB1C-4CD4-94D5-0319D14DB54B}.Release|x86.ActiveCfg = Release|Any CPU
+		{6992D926-AB1C-4CD4-94D5-0319D14DB54B}.Release|x86.Build.0 = Release|Any CPU
 	EndGlobalSection
 	GlobalSection(SolutionProperties) = preSolution
 		HideSolutionNode = FALSE
@@ -1114,6 +1128,7 @@ Global
 		{FE23BB65-276A-4E41-8CC7-F7752241DEBA} = {39CDF34B-FB23-49AE-AB27-0975DA379BB5}
 		{CBC96CC7-65AB-46EA-A82E-F6A788DABF80} = {F7876C9B-FB6A-4EFB-B058-D6967DB75FB2}
 		{E31F9B59-FCF1-4D04-8762-C7BB60285A7B} = {F7876C9B-FB6A-4EFB-B058-D6967DB75FB2}
+		{6992D926-AB1C-4CD4-94D5-0319D14DB54B} = {CFE3259A-2D30-4EB0-80D5-E8B5F3D01449}
 	EndGlobalSection
 	GlobalSection(ExtensibilityGlobals) = postSolution
 		SolutionGuid = {48EDBBBE-C8EE-4E3C-8B19-97184A487B37}

diff --git a/src/Compiler/AbstractIL/ilread.fs b/src/Compiler/AbstractIL/ilread.fs
@@ -931,7 +931,7 @@ let mkCacheInt32 lowMem _inbase _nm _sz =
     if lowMem then
         (fun f x -> f x)
     else
-        let mutable cache = null
+        let mutable cache: ConcurrentDictionary<int32, _> MaybeNull = null // TODO NULLNESS: this explicit annotation should not be needed
         let mutable count = 0
 #if STATISTICS
         addReport (fun oc ->
@@ -960,7 +960,7 @@ let mkCacheGeneric lowMem _inbase _nm _sz =
     if lowMem then
         (fun f x -> f x)
     else
-        let mutable cache = null
+        let mutable cache: ConcurrentDictionary<_, _> MaybeNull = null // TODO NULLNESS: this explicit annotation should not be needed
         let mutable count = 0
 #if STATISTICS
         addReport (fun oc ->

diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs
@@ -971,6 +971,43 @@ let TranslatePartialValReprInfo tps (PrelimValReprInfo (argsData, retData)) =
 // Members
 //-------------------------------------------------------------------------
 
+let TcAddNullnessToType (warn: bool) (cenv: cenv) (env: TcEnv) nullness innerTyC m =
+    let g = cenv.g
+    if g.langFeatureNullness then 
+        if TypeNullNever g innerTyC then
+            let tyString = NicePrint.minimalStringOfType env.DisplayEnv innerTyC
+            errorR(Error(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyString), m)) 
+
+        match tryAddNullnessToTy nullness innerTyC with 
+
+        | None -> 
+            let tyString = NicePrint.minimalStringOfType env.DisplayEnv innerTyC
+            errorR(Error(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyString), m)) 
+            innerTyC
+
+        | Some innerTyCWithNull ->
+            // The inner type is not allowed to support null or use null as a representation value.
+            // For example "int option?" is not allowed, nor "string??".
+            //
+            // For variable types in FSharp.Core we make an exception because we must allow
+            //    val toObj: value: 'T option -> 'T __withnull when 'T : not struct (* and 'T : __notnull *)
+            // wihout implying 'T is not null.  This is because it is legitimate to use this
+            // function to "collapse" null and obj-null-coming-from-option using such a function.
+
+            if not g.compilingFSharpCore || not (isTyparTy g innerTyC) then 
+                AddCxTypeDefnNotSupportsNull env.DisplayEnv cenv.css m NoTrace innerTyC
+
+            innerTyCWithNull
+
+    else
+        if warn then
+            warning(Error(FSComp.SR.tcNullnessCheckingNotEnabled(), m))
+        innerTyC
+
+//-------------------------------------------------------------------------
+// Members
+//-------------------------------------------------------------------------
+
 let ComputeLogicalName (id: Ident) (memberFlags: SynMemberFlags) =
     match memberFlags.MemberKind with
     | SynMemberKind.ClassConstructor -> ".cctor"
@@ -2085,7 +2122,7 @@ module GeneralizationHelpers =
             match tp.Constraints |> List.partition (function TyparConstraint.CoercesTo _ -> true | _ -> false) with
             | [TyparConstraint.CoercesTo(tgtTy, _)], others ->
                  // Throw away null constraints if they are implied
-                 if others |> List.exists (function TyparConstraint.SupportsNull _ -> not (TypeSatisfiesNullConstraint g m tgtTy) | _ -> true)
+                 if others |> List.exists (function TyparConstraint.SupportsNull _ -> not (TypeNullIsExtraValue g m tgtTy) | _ -> true)
                  then None
                  else Some tgtTy
             | _ -> None
@@ -3963,7 +4000,14 @@ let rec TcTyparConstraint ridx (cenv: cenv) newOk checkConstraints occ (env: TcE
         tpenv
 
     | SynTypeConstraint.WhereTyparSupportsNull(tp, m) ->
-        TcSimpleTyparConstraint cenv env newOk tpenv tp m AddCxTypeUseSupportsNull
+        TcSimpleTyparConstraint cenv env newOk tpenv tp m AddCxTypeDefnSupportsNull
+
+    | SynTypeConstraint.WhereTyparNotSupportsNull(tp, m) ->
+        if g.langFeatureNullness then 
+            TcSimpleTyparConstraint cenv env newOk tpenv tp m AddCxTypeDefnNotSupportsNull
+        else
+            warning(Error(FSComp.SR.tcNullnessCheckingNotEnabled(), m))
+            tpenv
 
     | SynTypeConstraint.WhereTyparIsComparable(tp, m) ->
         TcSimpleTyparConstraint cenv env newOk tpenv tp m AddCxTypeMustSupportComparison
@@ -4377,11 +4421,18 @@ and TcTypeOrMeasure kindOpt (cenv: cenv) newOk checkConstraints occ (iwsam: Warn
     | SynType.StaticConstant (synConst, m) ->
         TcTypeStaticConstant kindOpt tpenv synConst m
 
+    | SynType.StaticConstantNull m
     | SynType.StaticConstantNamed (_, _, m)
     | SynType.StaticConstantExpr (_, m) ->
         errorR(Error(FSComp.SR.parsInvalidLiteralInType(), m))
         NewErrorType (), tpenv
 
+    | SynType.WithNull(innerTy, ambivalent, m) -> 
+        let innerTyC, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv innerTy
+        let nullness = if ambivalent then KnownAmbivalentToNull else KnownWithNull
+        let tyWithNull = TcAddNullnessToType false cenv env nullness innerTyC m
+        tyWithNull, tpenv
+
     | SynType.MeasurePower(ty, exponent, m) ->
         TcTypeMeasurePower kindOpt cenv newOk checkConstraints occ env tpenv ty exponent m
 
@@ -4531,7 +4582,7 @@ and TcFunctionType (cenv: cenv) newOk checkConstraints occ env tpenv domainTy re
 and TcArrayType (cenv: cenv) newOk checkConstraints occ env tpenv rank elemTy m =
     let g = cenv.g
     let elemTy, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv elemTy
-    let tyR = mkArrayTy g rank elemTy m
+    let tyR = mkArrayTy g rank g.knownWithoutNull elemTy m
     tyR, tpenv
 
 and TcTypeParameter kindOpt (cenv: cenv) env newOk tpenv tp =
@@ -4556,8 +4607,9 @@ and TcTypeWithConstraints (cenv: cenv) env newOk checkConstraints occ tpenv synT
 and TcTypeHashConstraint (cenv: cenv) env newOk checkConstraints occ tpenv synTy m =
     let tp = TcAnonTypeOrMeasure (Some TyparKind.Type) cenv TyparRigidity.WarnIfNotRigid TyparDynamicReq.Yes newOk m
     let ty, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.No env tpenv synTy
-    AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace ty (mkTyparTy tp)
-    tp.AsType, tpenv
+    let tpTy = mkTyparTy tp
+    AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace ty tpTy
+    tpTy, tpenv
 
 and TcTypeStaticConstant kindOpt tpenv c m =
     match c, kindOpt with
@@ -4711,7 +4763,7 @@ and TcStaticConstantParameter (cenv: cenv) (env: TcEnv) tpenv kind (StripParenTy
             | SynConst.Double n when typeEquiv g g.float_ty kind -> record(g.float_ty); box (n: double)
             | SynConst.Char n when typeEquiv g g.char_ty kind -> record(g.char_ty); box (n: char)
             | SynConst.String (s, _, _)
-            | SynConst.SourceIdentifier (_, s, _) when s <> null && typeEquiv g g.string_ty kind -> record(g.string_ty); box (s: string)
+            | SynConst.SourceIdentifier (_, s, _) when typeEquiv g g.string_ty kind -> record(g.string_ty); box (s: string)
             | SynConst.Bool b when typeEquiv g g.bool_ty kind -> record(g.bool_ty); box (b: bool)
             | _ -> fail()
         v, tpenv
@@ -4740,7 +4792,6 @@ and TcStaticConstantParameter (cenv: cenv) (env: TcEnv) tpenv kind (StripParenTy
                 | Const.Single n -> record(g.float32_ty); box (n: single)
                 | Const.Double n -> record(g.float_ty); box (n: double)
                 | Const.Char n -> record(g.char_ty); box (n: char)
-                | Const.String null -> fail()
                 | Const.String s -> record(g.string_ty); box (s: string)
                 | Const.Bool b -> record(g.bool_ty); box (b: bool)
                 | _ -> fail()
@@ -4909,7 +4960,7 @@ and TcTypeApp (cenv: cenv) newOk checkConstraints occ env tpenv m tcref pathType
         List.iter2 (UnifyTypes cenv env m) tinst actualArgTys
 
     // Try to decode System.Tuple --> F# tuple types etc.
-    let ty = g.decompileType tcref actualArgTys
+    let ty = g.decompileType tcref actualArgTys g.knownWithoutNull
 
     ty, tpenv
 
@@ -5564,8 +5615,11 @@ and TcExprUndelayed (cenv: cenv) (overallTy: OverallTy) env tpenv (synExpr: SynE
 
     | SynExpr.Null m ->
         TcNonControlFlowExpr env <| fun env ->
+        // Which?
         AddCxTypeUseSupportsNull env.DisplayEnv cenv.css m NoTrace overallTy.Commit
-        mkNull m overallTy.Commit, tpenv
+        //AddCxTypeDefnSupportsNull env.DisplayEnv cenv.css m NoTrace overallTy.Commit
+        let tyWithNull = addNullnessToTy KnownWithNull overallTy.Commit
+        mkNull m tyWithNull, tpenv
 
     | SynExpr.Lazy (synInnerExpr, m) ->
         TcNonControlFlowExpr env <| fun env ->

diff --git a/src/Compiler/Checking/CheckPatterns.fs b/src/Compiler/Checking/CheckPatterns.fs
@@ -461,6 +461,8 @@ and TcRecordPat warnOnUpper cenv env vFlags patEnv ty fieldPats m =
 and TcNullPat cenv env patEnv ty m =
     try
         AddCxTypeUseSupportsNull env.DisplayEnv cenv.css m NoTrace ty
+        // Which?
+        //AddCxTypeDefnSupportsNull env.DisplayEnv cenv.css m NoTrace ty
     with exn ->
         errorRecovery exn m
     (fun _ -> TPat_null m), patEnv