Feature nullness :: apply nullness annotations to usages of 'obj' in Fsharp.Core

src/Compiler/Checking/CheckExpressions.fs

@@ -483,8 +483,9 @@ let UnifyOverallType (cenv: cenv) (env: TcEnv) m overallTy actualTy =
     match overallTy with
     | MustConvertTo(isMethodArg, reqdTy) when g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions ->
         let actualTy = tryNormalizeMeasureInType g actualTy
-        let reqdTy = tryNormalizeMeasureInType g reqdTy
-        if AddCxTypeEqualsTypeUndoIfFailed env.DisplayEnv cenv.css m reqdTy actualTy then
+        let reqdTy = tryNormalizeMeasureInType g reqdTy       
+        let reqTyForUnification = reqTyForArgumentNullnessInference g actualTy reqdTy           
+        if AddCxTypeEqualsTypeUndoIfFailed env.DisplayEnv cenv.css m reqTyForUnification actualTy then
             ()
         else
             // try adhoc type-directed conversions
@@ -2996,7 +2997,7 @@ let TcRuntimeTypeTest isCast isOperator (cenv: cenv) denv m tgtTy srcTy =
         else
             error(Error(FSComp.SR.tcTypeTestErased(NicePrint.minimalStringOfType denv tgtTy, NicePrint.minimalStringOfType denv (stripTyEqnsWrtErasure EraseAll g tgtTy)), m))
     else
-        for ety in getErasedTypes g tgtTy do
+        for ety in getErasedTypes g tgtTy true do
             if isMeasureTy g ety then
                 warning(Error(FSComp.SR.tcTypeTestLosesMeasures(NicePrint.minimalStringOfType denv ety), m))
             else

src/Compiler/Checking/ConstraintSolver.fs

@@ -1081,6 +1081,8 @@ and SolveNullnessSubsumesNullness (csenv: ConstraintSolverEnv) m2 (trace: Option
         SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 nv1.Solution nullness2
     | _, Nullness.Variable nv2 when nv2.IsSolved -> 
         SolveNullnessSubsumesNullness csenv m2 trace ty1 ty2 nullness1 nv2.Solution
+    | Nullness.Variable _nv1, Nullness.Known NullnessInfo.WithoutNull  -> 
+        CompleteD
     | Nullness.Variable nv1, _ -> 
         trace.Exec (fun () ->   nv1.Set nullness2) (fun () -> nv1.Unset())
         CompleteD
@@ -1414,6 +1416,8 @@ and SolveFunTypeEqn csenv ndeep m2 trace cxsln domainTy1 domainTy2 rangeTy1 rang
     trackErrors {
         // TODO NULLNESS: consider whether flipping the actual and expected in argument position
         // causes other problems, e.g. better/worse diagnostics
+        let g = csenv.g
+        let domainTy2 = reqTyForArgumentNullnessInference g domainTy1 domainTy2
         do! SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln domainTy2 domainTy1
         return! SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln rangeTy1 rangeTy2
     }

src/Compiler/Checking/MethodCalls.fs

@@ -480,7 +480,7 @@ let MakeCalledArgs amap m (minfo: MethInfo) minst =
         IsOutArg=isOutArg
         ReflArgInfo=reflArgInfo
         NameOpt=nmOpt
-        CalledArgumentType=calledArgTy })
+        CalledArgumentType= changeWithNullReqTyToVariable amap.g calledArgTy})
 
 /// <summary>
 /// Represents the syntactic matching between a caller of a method and the called method.

src/Compiler/TypedTree/TypedTreeBasics.fs

@@ -236,18 +236,22 @@ let rec stripUnitEqnsAux canShortcut unt =
     | _ -> unt
 
 let combineNullness (nullnessOrig: Nullness) (nullnessNew: Nullness) = 
-    match nullnessOrig.Evaluate() with
-    | NullnessInfo.WithoutNull -> nullnessNew
-    | NullnessInfo.AmbivalentToNull ->
-        match nullnessNew.Evaluate() with
-        | NullnessInfo.WithoutNull -> nullnessOrig
-        | NullnessInfo.AmbivalentToNull -> nullnessOrig
-        | NullnessInfo.WithNull -> nullnessNew
-    | NullnessInfo.WithNull -> 
-        match nullnessNew.Evaluate() with
-        | NullnessInfo.WithoutNull -> nullnessOrig
-        | NullnessInfo.AmbivalentToNull -> nullnessNew
-        | NullnessInfo.WithNull -> nullnessOrig
+    match nullnessOrig, nullnessNew with
+    | Nullness.Variable _, Nullness.Known NullnessInfo.WithoutNull -> 
+        nullnessOrig
+    | _ -> 
+        match nullnessOrig.Evaluate() with
+        | NullnessInfo.WithoutNull -> nullnessNew
+        | NullnessInfo.AmbivalentToNull ->
+            match nullnessNew.Evaluate() with
+            | NullnessInfo.WithoutNull -> nullnessOrig
+            | NullnessInfo.AmbivalentToNull -> nullnessOrig
+            | NullnessInfo.WithNull -> nullnessNew
+        | NullnessInfo.WithNull -> 
+            match nullnessNew.Evaluate() with
+            | NullnessInfo.WithoutNull -> nullnessOrig
+            | NullnessInfo.AmbivalentToNull -> nullnessNew
+            | NullnessInfo.WithNull -> nullnessOrig
 
 let nullnessEquiv (nullnessOrig: Nullness) (nullnessNew: Nullness) = LanguagePrimitives.PhysicalEquality nullnessOrig nullnessNew
 
@@ -278,8 +282,9 @@ let tryAddNullnessToTy nullnessNew (ty:TType) =
     | TType_measure _ -> None
 
 let addNullnessToTy (nullness: Nullness) (ty:TType) =
-    match nullness.Evaluate() with
-    | NullnessInfo.WithoutNull -> ty
+    match nullness with
+    | Nullness.Known NullnessInfo.WithoutNull -> ty
+    | Nullness.Variable nv when nv.IsSolved && nv.Evaluate() = NullnessInfo.WithoutNull -> ty
     | _ -> 
     match ty with
     | TType_var (tp, nullnessOrig) -> TType_var (tp, combineNullness nullnessOrig nullness)

src/Compiler/TypedTree/TypedTreeOps.fs

@@ -1156,30 +1156,30 @@ let isErasedType g ty =
   | _ -> false
 
 // Return all components of this type expression that cannot be tested at runtime
-let rec getErasedTypes g ty = 
+let rec getErasedTypes g ty checkForNullness = 
     let ty = stripTyEqns g ty
     if isErasedType g ty then [ty] else 
     match ty with
     | TType_forall(_, bodyTy) -> 
-        getErasedTypes g bodyTy
+        getErasedTypes g bodyTy checkForNullness
 
     | TType_var (tp, nullness) -> 
-        match nullness.Evaluate() with
-        | NullnessInfo.WithNull -> [ty] // with-null annotations can't be tested at runtime (TODO NULLNESS: for value types Nullable<_> they can be)
+        match checkForNullness, nullness.Evaluate() with
+        | true, NullnessInfo.WithNull -> [ty] // with-null annotations can't be tested at runtime (TODO NULLNESS: for value types Nullable<_> they can be)
         | _ -> if tp.IsErased then [ty] else []
 
     | TType_app (_, b, nullness) ->
-        match nullness.Evaluate() with
-        | NullnessInfo.WithNull -> [ty]
-        | _ -> List.foldBack (fun ty tys -> getErasedTypes g ty @ tys) b []
+        match checkForNullness, nullness.Evaluate() with
+        | true, NullnessInfo.WithNull -> [ty]
+        | _ -> List.foldBack (fun ty tys -> getErasedTypes g ty false @ tys) b []
 
     | TType_ucase(_, b) | TType_anon (_, b) | TType_tuple (_, b) ->
-        List.foldBack (fun ty tys -> getErasedTypes g ty @ tys) b []
+        List.foldBack (fun ty tys -> getErasedTypes g ty false @ tys) b []
 
     | TType_fun (domainTy, rangeTy, nullness) -> 
-        match nullness.Evaluate() with
-        | NullnessInfo.WithNull -> [ty]
-        | _ -> getErasedTypes g domainTy @ getErasedTypes g rangeTy
+        match checkForNullness, nullness.Evaluate() with
+        | true, NullnessInfo.WithNull -> [ty]
+        | _ -> getErasedTypes g domainTy false @ getErasedTypes g rangeTy false
     | TType_measure _ -> 
         [ty]
 
@@ -9157,11 +9157,33 @@ let nullnessOfTy g ty =
     |> function
         | TType_app(tcref, _, nullness) ->
             let nullness2 = intrinsicNullnessOfTyconRef g tcref
-            combineNullness nullness nullness2
+            if nullness2 === g.knownWithoutNull then
+                nullness
+            else
+                combineNullness nullness nullness2
         | TType_fun (_, _, nullness) | TType_var (_, nullness) ->
             nullness
         | _ -> g.knownWithoutNull
 
+let changeWithNullReqTyToVariable g reqTy =
+    let sty = stripTyEqns g reqTy
+    match isTyparTy g sty with
+    | false ->
+        match nullnessOfTy g sty with
+        | Nullness.Known NullnessInfo.WithNull -> 
+            reqTy |> replaceNullnessOfTy (NewNullnessVar())
+        | _ -> reqTy
+    | true -> reqTy
+
+/// When calling a null-allowing API, we prefer to infer a without null argument for idiomatic F# code.
+/// That is, unless caller explicitely marks a value (e.g. coming from a function parameter) as WithNull, it should not be infered as such.
+let reqTyForArgumentNullnessInference g actualTy reqTy =
+    // Only change reqd nullness if actualTy is an inference variable
+    match tryDestTyparTy g actualTy with
+    | ValueSome t when t.IsCompilerGenerated && not(t.Constraints |> List.exists(function | TyparConstraint.SupportsNull _ -> true | _ -> false))->
+        changeWithNullReqTyToVariable g reqTy       
+    | _ -> reqTy
+
 /// The new logic about whether a type admits the use of 'null' as a value.
 let TypeNullIsExtraValueNew g m ty = 
     let sty = stripTyparEqns ty

src/Compiler/TypedTree/TypedTreeOps.fsi

@@ -649,6 +649,10 @@ val tryDestForallTy: TcGlobals -> TType -> Typars * TType
 
 val nullnessOfTy: TcGlobals -> TType -> Nullness
 
+val changeWithNullReqTyToVariable: TcGlobals -> reqTy: TType -> TType
+
+val reqTyForArgumentNullnessInference: TcGlobals -> actualTy: TType -> reqTy: TType -> TType
+
 val isFunTy: TcGlobals -> TType -> bool
 
 val isForallTy: TcGlobals -> TType -> bool
@@ -923,7 +927,7 @@ val anonInfoEquiv: AnonRecdTypeInfo -> AnonRecdTypeInfo -> bool
 val isErasedType: TcGlobals -> TType -> bool
 
 // Return all components (units-of-measure, and types) of this type that would be erased
-val getErasedTypes: TcGlobals -> TType -> TType list
+val getErasedTypes: TcGlobals -> TType -> checkForNullness: bool -> TType list
 
 //-------------------------------------------------------------------------
 // Unit operations

src/FSharp.Core/Linq.fs

@@ -55,15 +55,15 @@ module LeafExpressionConverter =
         tyargs.[0], tyargs.[1]
 
     let StringConcat =
-       methodhandleof (fun (x:obj, y:obj) -> String.Concat (x, y))
+       methodhandleof (fun (x:objnull, y:objnull) -> String.Concat (x, y))
        |> System.Reflection.MethodInfo.GetMethodFromHandle
        :?> MethodInfo
 
-    let SubstHelperRaw (q:Expr, x:Var array, y:obj array) : Expr =
+    let SubstHelperRaw (q:Expr, x:Var array, y:objnull array) : Expr =
         let d = Map.ofArray (Array.zip x y)
         q.Substitute(fun v -> v |> d.TryFind |> Option.map (fun x -> Expr.Value (x, v.Type)))
 
-    let SubstHelper<'T> (q:Expr, x:Var array, y:obj array) : Expr<'T> =
+    let SubstHelper<'T> (q:Expr, x:Var array, y:objnull array) : Expr<'T> =
         SubstHelperRaw(q, x, y) |> Expr.Cast
 
     let showAll =
@@ -393,12 +393,12 @@ module LeafExpressionConverter =
     //let (|ArrayAssignQ|_|) = (|SpecificCallToMethod|_|) (methodhandleof (fun -> LanguagePrimitives.IntrinsicFunctions.SetArray : int array -> int -> int -> unit))
     //let (|ArrayTypeQ|_|) (ty:System.Type) = if ty.IsArray && ty.GetArrayRank() = 1 then Some (ty.GetElementType()) else None
     let substHelperMeth =
-        methodhandleof (fun (x:Expr, y:Var array, z:obj array) -> SubstHelper<obj> (x, y, z))
+        methodhandleof (fun (x:Expr, y:Var array, z:objnull array) -> SubstHelper<obj> (x, y, z))
         |> System.Reflection.MethodInfo.GetMethodFromHandle
         :?> MethodInfo
 
     let substHelperRawMeth =
-        methodhandleof (fun (x:Expr, y:Var array, z:obj array) -> SubstHelperRaw (x, y, z))
+        methodhandleof (fun (x:Expr, y:Var array, z:objnull array) -> SubstHelperRaw (x, y, z))
         |> System.Reflection.MethodInfo.GetMethodFromHandle
         :?> MethodInfo
 
@@ -895,7 +895,7 @@ module LeafExpressionConverter =
     // provides no other way to evaluate the expression.
     //
     // REVIEW: It is possible it is just better to interpret the expression in many common cases, e.g. property-gets, values etc.
-    let EvaluateQuotation (e: Microsoft.FSharp.Quotations.Expr) : obj =
+    let EvaluateQuotation (e: Microsoft.FSharp.Quotations.Expr) : objnull =
 #if FX_NO_QUOTATIONS_COMPILE
        raise (new NotSupportedException())
 #else

src/FSharp.Core/Linq.fsi

@@ -71,21 +71,21 @@ module LeafExpressionConverter =
     /// </summary>
     ///
     /// <example-tbd></example-tbd>
-    val EvaluateQuotation: Expr -> obj
+    val EvaluateQuotation: Expr -> objnull
 
     /// <summary>
     /// A runtime helper used to evaluate nested quotation literals.
     /// </summary>
     ///
     /// <example-tbd></example-tbd>
-    val SubstHelper: Expr * Var array * obj array -> Expr<'T>
+    val SubstHelper: Expr * Var array * objnull array -> Expr<'T>
 
     /// <summary>
     /// A runtime helper used to evaluate nested quotation literals.
     /// </summary>
     ///
     /// <example-tbd></example-tbd>
-    val SubstHelperRaw: Expr * Var array * obj array -> Expr
+    val SubstHelperRaw: Expr * Var array * objnull array -> Expr
 
     val internal (|SpecificCallToMethod|_|):
         System.RuntimeMethodHandle -> (Expr -> (Expr option * Reflection.MethodInfo * Expr list) option)

src/FSharp.Core/Query.fs

@@ -372,7 +372,7 @@ module Query =
 
     let CallGenericStaticMethod (methHandle:System.RuntimeMethodHandle) =
         let methInfo = methHandle |> System.Reflection.MethodInfo.GetMethodFromHandle :?> MethodInfo
-        fun (tyargs: Type list, args: obj list) ->
+        fun (tyargs: Type list, args: objnull list) ->
             let methInfo = if methInfo.IsGenericMethod then methInfo.MakeGenericMethod(Array.ofList tyargs) else methInfo
             try
                methInfo.Invoke(null, Array.ofList args)
@@ -381,7 +381,7 @@ module Query =
 
     let CallGenericInstanceMethod (methHandle:System.RuntimeMethodHandle) =
         let methInfo = methHandle |> System.Reflection.MethodInfo.GetMethodFromHandle :?> MethodInfo
-        fun (objExpr:obj, tyargs: Type list, args: obj list) ->
+        fun (objExpr:obj, tyargs: Type list, args: objnull list) ->
             let methInfo = if methInfo.IsGenericMethod then methInfo.MakeGenericMethod(Array.ofList tyargs) else methInfo
             try
                methInfo.Invoke(objExpr, Array.ofList args)
@@ -467,7 +467,7 @@ module Query =
             else
                 ME ([srcItemTy], [src; key])
 
-        let Call (isIQ, srcItemTy, src:obj, key: Expr) =
+        let Call (isIQ, srcItemTy, src:objnull, key: Expr) =
             let key = key |> LeafExpressionConverter.EvaluateQuotation
             let C = if isIQ then CQ else CE
             C ([srcItemTy], [src; box key])
@@ -496,7 +496,7 @@ module Query =
             else
                 ME ([srcItemTy; keyElemTy], [src; valSelector])
 
-        let Call (isIQ, srcItemTy: Type, _keyItemTy: Type, src:obj, keyElemTy: Type, v: Var, res: Expr) =
+        let Call (isIQ, srcItemTy: Type, _keyItemTy: Type, src:objnull, keyElemTy: Type, v: Var, res: Expr) =
             if isIQ then
                 let selector = FuncExprToLinqFunc2Expression (srcItemTy, keyElemTy, v, res)
                 CQ ([srcItemTy; keyElemTy], [src; box selector])
@@ -505,7 +505,7 @@ module Query =
                 CE ([srcItemTy; keyElemTy], [src; selector])
         Make, Call
 
-    let (MakeMinBy: bool * Expr * Var * Expr -> Expr), (CallMinBy : bool * Type * Type * obj * Type * Var * Expr -> obj) =
+    let (MakeMinBy: bool * Expr * Var * Expr -> Expr), (CallMinBy : bool * Type * Type * objnull * Type * Var * Expr -> obj) =
         let FQ = methodhandleof (fun (x, y: Expression<Func<_, _>>) -> System.Linq.Queryable.Min(x, y))
         let FE = methodhandleof (fun (x, y: Func<_, 'Result>) -> Enumerable.Min(x, y))
         MakeOrCallMinByOrMaxBy FQ FE
@@ -539,7 +539,7 @@ module Query =
             else
                 ME ([srcItemTy], [src; predicate])
 
-        let Call (isIQ, srcItemTy: Type, src:obj, v: Var, res: Expr) =
+        let Call (isIQ, srcItemTy: Type, src:objnull, v: Var, res: Expr) =
             if isIQ then
                 let selector = FuncExprToLinqFunc2Expression (srcItemTy, boolTy, v, res)
                 CQ ([srcItemTy], [src; box selector])
@@ -612,7 +612,7 @@ module Query =
                     let selector = Expr.Lambda (v, res)
                     ME (qb, [srcItemTy; qTy; resTyNoNullable], [src; selector])
 
-        let Call (qb:obj, isIQ, srcItemTy: Type, resTyNoNullable: Type, src:obj, resTy: Type, v: Var, res: Expr) =
+        let Call (qb:obj, isIQ, srcItemTy: Type, resTyNoNullable: Type, src:objnull, resTy: Type, v: Var, res: Expr) =
             if isIQ then
                 let selector = FuncExprToLinqFunc2Expression (srcItemTy, resTy, v, res)
                 let caller =

src/FSharp.Core/async.fs

@@ -1076,7 +1076,7 @@ module AsyncPrimitives =
 
     /// Create an instance of an arbitrary delegate type delegating to the given F# function
     type FuncDelegate<'T>(f) =
-        member _.Invoke(sender: obj, a: 'T) : unit =
+        member _.Invoke(sender: objnull, a: 'T) : unit =
             ignore sender
             f a
 
@@ -1309,7 +1309,7 @@ module AsyncPrimitives =
         | None -> ()
 
     [<Sealed; AutoSerializable(false)>]
-    type AsyncIAsyncResult<'T>(callback: System.AsyncCallback, state: obj) =
+    type AsyncIAsyncResult<'T>(callback: System.AsyncCallback, state: objnull) =
         // This gets set to false if the result is not available by the
         // time the IAsyncResult is returned to the caller of Begin
         let mutable completedSynchronously = true
@@ -2035,7 +2035,7 @@ type Async =
                             // Register the result.
                             resultCell.RegisterResult(res, reuseThread = true) |> unfake)
 
-            let (iar: IAsyncResult) = beginAction (callback, (null: obj))
+            let (iar: IAsyncResult) = beginAction (callback, (null: objnull))
 
             if iar.CompletedSynchronously then
                 // Ensure cancellation is not possible beyond this point
@@ -2067,7 +2067,7 @@ type Async =
     static member AsBeginEnd<'Arg, 'T>
         (computation: ('Arg -> Async<'T>))
         // The 'Begin' member
-        : ('Arg * System.AsyncCallback * obj -> System.IAsyncResult) *
+        : ('Arg * System.AsyncCallback * objnull -> System.IAsyncResult) *
           (System.IAsyncResult -> 'T) *
           (System.IAsyncResult -> unit)
         =
@@ -2334,7 +2334,7 @@ module WebExtensions =
                 Async.FromContinuations(fun (cont, econt, ccont) ->
                     let userToken = obj ()
 
-                    let rec delegate' (_: obj) (args: #ComponentModel.AsyncCompletedEventArgs) =
+                    let rec delegate' (_: objnull) (args: #ComponentModel.AsyncCompletedEventArgs) =
                         // ensure we handle the completed event from correct download call
                         if userToken = args.UserState then
                             event.RemoveHandler handle