Feature nullness :: Subsume nullness for contravariant type parameters (such as the one in IEqualityComparer<in T>)

src/Compiler/Checking/ConstraintSolver.fs

@@ -1411,6 +1411,36 @@ and SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln origl1 origl2 =
                ErrorD(ConstraintSolverTupleDiffLengths(csenv.DisplayEnv, csenv.eContextInfo, origl1, origl2, csenv.m, m2)) 
        loop origl1 origl2
 
+and SolveTypeEqualsTypeWithContravarianceEqns (csenv:ConstraintSolverEnv) ndeep m2 trace cxsln origl1 origl2 typars =
+   let isContravariant (t:Typar) = 
+        t.typar_opt_data 
+        |> Option.map (fun d -> d.typar_is_contravariant) 
+        |> Option.defaultValue(false)
+
+   match origl1, origl2, typars with
+   | [], [], [] -> CompleteD
+   | _ ->
+       // We unwind Iterate2D by hand here for performance reasons.
+       let rec loop l1 l2 tps =
+           match l1, l2, tps with
+           | [], [], [] -> CompleteD
+           | h1 :: t1, h2 :: t2, hTp :: tTps when t1.Length = t2.Length && t1.Length = tTps.Length ->
+               trackErrors {
+                    let h1 =
+                        // For contravariant typars (`<in T> in C#'), if the required type is WithNull, the actual type can have any nullness it wants
+                        // Without this added logic, their nullness would be forced to be equal.
+                        if isContravariant hTp && (nullnessOfTy csenv.g h2).TryEvaluate() = ValueSome NullnessInfo.WithNull  then                            
+                            replaceNullnessOfTy csenv.g.knownWithNull h1
+                        else
+                            h1
+
+                    do! SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln h1 h2
+                    do! loop t1 t2 tTps
+               }
+           | _ ->
+               ErrorD(ConstraintSolverTupleDiffLengths(csenv.DisplayEnv, csenv.eContextInfo, origl1, origl2, csenv.m, m2)) 
+       loop origl1 origl2 typars
+
 and SolveFunTypeEqn csenv ndeep m2 trace cxsln domainTy1 domainTy2 rangeTy1 rangeTy2 =
     trackErrors {
         let g = csenv.g
@@ -1503,11 +1533,11 @@ and SolveTypeSubsumesType (csenv: ConstraintSolverEnv) ndeep m2 (trace: Optional
                       (tyconRefEq g tagc1 g.byrefkind_In_tcr || tyconRefEq g tagc1 g.byrefkind_Out_tcr) ) -> ()
             | _ -> return! SolveTypeEqualsType csenv ndeep m2 trace cxsln tag1 tag2
            }
-        | _ -> SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln l1 l2
+        | _ -> 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! SolveTypeEqualsTypeEqns csenv ndeep m2 trace cxsln l1 l2
+        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)
         }
 

src/Compiler/Checking/import.fs

@@ -624,6 +624,8 @@ let ImportILGenericParameters amap m scoref tinst (nullableFallback:Nullness.Nul
         let tptys = tps |> List.map mkTyparTy
         let importInst = tinst@tptys
         (tps, gps) ||> List.iter2 (fun tp gp -> 
+            if gp.Variance = ILGenericVariance.ContraVariant then
+                tp.MarkAsContravariant()
             let constraints = 
                 [  
                   if amap.g.langFeatureNullness && amap.g.checkNullness then

src/Compiler/TypedTree/TypedTree.fs

@@ -2254,6 +2254,9 @@ type TyparOptionalData =
 
       /// The declared attributes of the type parameter. Empty for type inference variables. 
       mutable typar_attribs: Attribs
+
+      /// Set to true if the typar is contravariant, i.e. declared as <in T> in C#
+      mutable typar_is_contravariant: bool
     }
 
     [<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
@@ -2355,10 +2358,10 @@ type Typar =
     member x.SetAttribs attribs = 
         match attribs, x.typar_opt_data with
         | [], None -> ()
-        | [], Some { typar_il_name = None; typar_xmldoc = doc; typar_constraints = [] } when doc.IsEmpty ->
+        | [], Some { typar_il_name = None; typar_xmldoc = doc; typar_constraints = []; typar_is_contravariant = false } when doc.IsEmpty ->
             x.typar_opt_data <- None
         | _, Some optData -> optData.typar_attribs <- attribs
-        | _ -> x.typar_opt_data <- Some { typar_il_name = None; typar_xmldoc = XmlDoc.Empty; typar_constraints = []; typar_attribs = attribs }
+        | _ -> x.typar_opt_data <- Some { typar_il_name = None; typar_xmldoc = XmlDoc.Empty; typar_constraints = []; typar_attribs = attribs; typar_is_contravariant = false }
 
     /// Get the XML documetnation for the type parameter
     member x.XmlDoc =
@@ -2376,7 +2379,7 @@ type Typar =
     member x.SetILName il_name =
         match x.typar_opt_data with
         | Some optData -> optData.typar_il_name <- il_name
-        | _ -> x.typar_opt_data <- Some { typar_il_name = il_name; typar_xmldoc = XmlDoc.Empty; typar_constraints = []; typar_attribs = [] }
+        | _ -> x.typar_opt_data <- Some { typar_il_name = il_name; typar_xmldoc = XmlDoc.Empty; typar_constraints = []; typar_attribs = []; typar_is_contravariant = false }
 
     /// Indicates the display name of a type variable
     member x.DisplayName = if x.Name = "?" then "?"+string x.Stamp else x.Name
@@ -2385,10 +2388,17 @@ type Typar =
     member x.SetConstraints cs =
         match cs, x.typar_opt_data with
         | [], None -> ()
-        | [], Some { typar_il_name = None; typar_xmldoc = doc; typar_attribs = [] } when doc.IsEmpty ->
+        | [], Some { typar_il_name = None; typar_xmldoc = doc; typar_attribs = [];typar_is_contravariant = false } when doc.IsEmpty ->
             x.typar_opt_data <- None
         | _, Some optData -> optData.typar_constraints <- cs
-        | _ -> x.typar_opt_data <- Some { typar_il_name = None; typar_xmldoc = XmlDoc.Empty; typar_constraints = cs; typar_attribs = [] }
+        | _ -> x.typar_opt_data <- Some { typar_il_name = None; typar_xmldoc = XmlDoc.Empty; typar_constraints = cs; typar_attribs = []; typar_is_contravariant = false }
+
+    /// Marks the typar as being contravariant
+    member x.MarkAsContravariant() = 
+        match x.typar_opt_data with
+        | Some optData -> optData.typar_is_contravariant <- true
+        | _ ->
+            x.typar_opt_data <- Some { typar_il_name = None; typar_xmldoc = XmlDoc.Empty; typar_constraints = []; typar_attribs = []; typar_is_contravariant = true }
 
     /// Creates a type variable that contains empty data, and is not yet linked. Only used during unpickling of F# metadata.
     static member NewUnlinked() : Typar = 
@@ -2410,7 +2420,7 @@ type Typar =
         x.typar_solution <- tg.typar_solution
         match tg.typar_opt_data with
         | Some tg -> 
-            let optData = { typar_il_name = tg.typar_il_name; typar_xmldoc = tg.typar_xmldoc; typar_constraints = tg.typar_constraints; typar_attribs = tg.typar_attribs }
+            let optData = { typar_il_name = tg.typar_il_name; typar_xmldoc = tg.typar_xmldoc; typar_constraints = tg.typar_constraints; typar_attribs = tg.typar_attribs; typar_is_contravariant = tg.typar_is_contravariant }
             x.typar_opt_data <- Some optData
         | None -> ()
 
@@ -6142,7 +6152,7 @@ type Construct() =
             typar_opt_data =
                 match attribs with
                 | [] -> None
-                | _ -> Some { typar_il_name = None; typar_xmldoc = XmlDoc.Empty; typar_constraints = []; typar_attribs = attribs } } 
+                | _ -> Some { typar_il_name = None; typar_xmldoc = XmlDoc.Empty; typar_constraints = []; typar_attribs = attribs; typar_is_contravariant = false  } } 
 
     /// Create a new type parameter node for a declared type parameter
     static member NewRigidTypar nm m =

src/Compiler/TypedTree/TypedTree.fsi

@@ -1485,6 +1485,9 @@ type TyparOptionalData =
 
         /// The declared attributes of the type parameter. Empty for type inference variables.
         mutable typar_attribs: Attribs
+
+        /// Set to true if the typar is contravariant, i.e. declared as <in T> in C#
+        mutable typar_is_contravariant: bool
     }
 
     override ToString: unit -> string
@@ -1541,6 +1544,9 @@ type Typar =
     /// Adjusts the constraints associated with a type variable
     member SetConstraints: cs: TyparConstraint list -> unit
 
+    /// Marks the typar as being contravariant
+    member MarkAsContravariant: unit -> unit
+
     /// Sets whether a type variable is required at runtime
     member SetDynamicReq: b: TyparDynamicReq -> unit
 

src/Compiler/TypedTree/TypedTreeBasics.fs

@@ -198,7 +198,7 @@ let mkTyparTy (tp:Typar) =
 // For fresh type variables clear the StaticReq when copying because the requirement will be re-established through the
 // process of type inference.
 let copyTypar clearStaticReq (tp: Typar) = 
-    let optData = tp.typar_opt_data |> Option.map (fun tg -> { typar_il_name = tg.typar_il_name; typar_xmldoc = tg.typar_xmldoc; typar_constraints = tg.typar_constraints; typar_attribs = tg.typar_attribs })
+    let optData = tp.typar_opt_data |> Option.map (fun tg -> { typar_il_name = tg.typar_il_name; typar_xmldoc = tg.typar_xmldoc; typar_constraints = tg.typar_constraints; typar_attribs = tg.typar_attribs; typar_is_contravariant = tg.typar_is_contravariant  })
     let flags = if clearStaticReq then tp.typar_flags.WithStaticReq(TyparStaticReq.None) else tp.typar_flags
     Typar.New { typar_id = tp.typar_id
                 typar_flags = flags

src/Compiler/TypedTree/TypedTreePickle.fs

@@ -1683,7 +1683,7 @@ let u_tyar_spec_data st =
       typar_opt_data=
         match g, e, c with
         | doc, [], [] when doc.IsEmpty -> None
-        | _ -> Some { typar_il_name = None; typar_xmldoc = g; typar_constraints = e; typar_attribs = c } }
+        | _ -> Some { typar_il_name = None; typar_xmldoc = g; typar_constraints = e; typar_attribs = c;typar_is_contravariant = false } }
 
 let u_tyar_spec st =
     u_osgn_decl st.itypars u_tyar_spec_data st

tests/FSharp.Compiler.ComponentTests/Language/Nullness/NullableReferenceTypesTests.fs

@@ -849,6 +849,31 @@ let mappableFunc =
     |> typeCheckWithStrictNullness
     |> shouldSucceed
 
+[<Fact>]
+let ``Importing and processing contravariant interfaces`` () = 
+
+    FSharp """module MyLibrary
+
+open System
+open System.Collections.Concurrent
+open System.Collections.Generic
+
+
+let cmp1 : IEqualityComparer<string> = StringComparer.Ordinal
+let cmp2 : IEqualityComparer<string | null> = StringComparer.Ordinal
+let stringHash = cmp2.GetHashCode("abc")
+let nullHash = cmp2.GetHashCode(null)
+let nullEquals = cmp2.Equals("abc", null)
+
+let dict = ConcurrentDictionary<string, int> (StringComparer.Ordinal)
+dict["ok"] <- 42
+
+"""
+    |> asLibrary
+    |> typeCheckWithStrictNullness
+    |> shouldSucceed
+
+
 [<Fact>]
 let ``Notnull constraint and inline annotated value`` () = 
     FSharp """module MyLibrary