Feature/nullness - parsing of constraints

.fantomasignore

@@ -89,6 +89,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

FSharp.Profiles.props

@@ -1,6 +1,36 @@
 <?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 use of the feature within the codebase -->
+    <!-- The default is off - it is selectively enabled -->
+    <CheckNulls Condition="'$(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'">
+    <CheckNulls>false</CheckNulls>
+    <DefineConstants>NO_CHECKNULLS;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' ">

FSharpBuild.Directory.Build.props

@@ -112,12 +112,9 @@
   </PropertyGroup>
 
   <!-- use this to enable good debugging in the Proto bootstrap compiler -->
-  <!-- You'll have to remove it to get the actual compiler bo build because optimization is needed for some large methods -->
-  <!--
-  <PropertyGroup Condition="'$(Configuration)' == 'Proto'">
+  <PropertyGroup Condition="'$(ProtoDebug)' == 'true'">
     <DebugSymbols>true</DebugSymbols>
     <Optimize>false</Optimize>
     <Tailcalls>true</Tailcalls>
   </PropertyGroup>
-  -->
 </Project>

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\adhoc\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}

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 ->

src/Compiler/Checking/CheckDeclarations.fs

@@ -3300,7 +3300,6 @@ module EstablishTypeDefinitionCores =
                     tycon.TypeContents.tcaug_super |> Option.iter (fun ty -> if not (TypeNullIsExtraValue g m ty) then errorR (Error(FSComp.SR.tcAllowNullTypesMayOnlyInheritFromAllowNullTypes(), m)))
                     tycon.ImmediateInterfaceTypesOfFSharpTycon |> List.iter (fun ty -> if not (TypeNullIsExtraValue g m ty) then errorR (Error(FSComp.SR.tcAllowNullTypesMayOnlyInheritFromAllowNullTypes(), m)))
 
-
             let structLayoutAttributeCheck allowed = 
                 let explicitKind = int32 System.Runtime.InteropServices.LayoutKind.Explicit
                 match structLayoutAttr with

src/Compiler/Checking/CheckExpressions.fs

@@ -977,6 +977,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"
@@ -2099,7 +2136,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
@@ -3984,6 +4021,13 @@ let rec TcTyparConstraint ridx (cenv: cenv) newOk checkConstraints occ (env: TcE
     | SynTypeConstraint.WhereTyparSupportsNull(tp, m) ->
         TcSimpleTyparConstraint cenv env newOk tpenv tp m AddCxTypeUseSupportsNull
 
+    | 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
 
@@ -4400,11 +4444,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
 
@@ -4556,7 +4607,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 =
@@ -4581,8 +4632,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
 
 // (x: 't & #I1 & #I2)
 // (x: #I1 & #I2)
@@ -4605,7 +4657,7 @@ and TcIntersectionConstraint (cenv: cenv) env newOk checkConstraints occ tpenv s
             | _ -> tpenv
         ) tpenv
 
-    tp.AsType, tpenv
+    tp.AsType KnownAmbivalentToNull, tpenv
 
 and TcTypeStaticConstant kindOpt tpenv c m =
     match c, kindOpt with
@@ -4759,7 +4811,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
@@ -4788,7 +4840,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()
@@ -4957,7 +5008,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
 
@@ -5621,7 +5672,8 @@ and TcExprUndelayed (cenv: cenv) (overallTy: OverallTy) env tpenv (synExpr: SynE
     | SynExpr.Null m ->
         TcNonControlFlowExpr env <| fun env ->
         AddCxTypeUseSupportsNull env.DisplayEnv cenv.css m NoTrace overallTy.Commit
-        mkNull m overallTy.Commit, tpenv
+        let tyWithNull = addNullnessToTy KnownWithNull overallTy.Commit
+        mkNull m tyWithNull, tpenv
 
     | SynExpr.Lazy (synInnerExpr, m) ->
         TcNonControlFlowExpr env <| fun env ->