Better generic unmanaged structs handling ++ bidirectional F#/C# interop for 'unmanaged' constraint (#12154)

Co-authored-by: Vlad Zarytovskii <[email protected]>
Co-authored-by: Tomas Grosup <[email protected]>

Author: vzarytovskii

src/Compiler/AbstractIL/ilwrite.fs

@@ -2490,6 +2490,7 @@ let rec GetGenericParamAsGenericParamRow cenv _env idx owner gp =
         (if gp.HasReferenceTypeConstraint then 0x0004 else 0x0000) |||
         (if gp.HasNotNullableValueTypeConstraint then 0x0008 else 0x0000) |||
         (if gp.HasDefaultConstructorConstraint then 0x0010 else 0x0000)
+   
 
     let mdVersionMajor, _ = metadataSchemaVersionSupportedByCLRVersion cenv.desiredMetadataVersion
     if (mdVersionMajor = 1) then

src/Compiler/Checking/ConstraintSolver.fs

@@ -2139,6 +2139,10 @@ and EnforceConstraintConsistency (csenv: ConstraintSolverEnv) ndeep m2 trace ret
     | TyparConstraint.IsNonNullableStruct _, TyparConstraint.IsReferenceType _
     | TyparConstraint.IsReferenceType _, TyparConstraint.IsNonNullableStruct _   ->
         return! ErrorD (Error(FSComp.SR.csStructConstraintInconsistent(), m))
+    
+    | TyparConstraint.IsUnmanaged _, TyparConstraint.IsReferenceType _
+    | TyparConstraint.IsReferenceType _, TyparConstraint.IsUnmanaged _ ->
+        return! ErrorD (Error(FSComp.SR.csUnmanagedConstraintInconsistent(), m))
 
     | TyparConstraint.SupportsComparison _, TyparConstraint.SupportsComparison _
     | TyparConstraint.SupportsEquality _, TyparConstraint.SupportsEquality _
@@ -2421,17 +2425,31 @@ and SolveTypeIsNonNullableValueType (csenv: ConstraintSolverEnv) ndeep m2 trace
     }            
 
 and SolveTypeIsUnmanaged (csenv: ConstraintSolverEnv) ndeep m2 trace ty =
-    let g = csenv.g
-    let m = csenv.m
-    let denv = csenv.DisplayEnv
-    match tryDestTyparTy g ty with
-    | ValueSome destTypar ->
-        AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.IsUnmanaged m)
-    | _ ->
-        if isUnmanagedTy g ty then
-            CompleteD
-        else
-            ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresUnmanagedType(NicePrint.minimalStringOfType denv ty), m, m2))
+    trackErrors {
+        let g = csenv.g
+        let m = csenv.m
+        let denv = csenv.DisplayEnv
+        match tryDestTyparTy g ty with
+        | ValueSome destTypar ->
+            return! AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.IsUnmanaged m)
+        | _ ->
+            if isStructAnonRecdTy g ty then
+                return! destStructAnonRecdTy g ty |> IterateD (SolveTypeIsUnmanaged csenv (ndeep + 1) m2 trace)
+            else if isStructTupleTy g ty then
+                return! destStructTupleTy g ty |> IterateD (SolveTypeIsUnmanaged csenv (ndeep + 1) m2 trace)
+            else if isStructUnionTy g ty then
+                let tcref = tryTcrefOfAppTy g ty |> ValueOption.get
+                let tinst = mkInstForAppTy g ty
+                return!
+                    tcref.UnionCasesAsRefList            
+                    |> List.collect (actualTysOfUnionCaseFields tinst)
+                    |> IterateD (SolveTypeIsUnmanaged csenv (ndeep + 1) m2 trace)
+            else
+                if isUnmanagedTy g ty then
+                    return! CompleteD
+                else
+                    return! ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresUnmanagedType(NicePrint.minimalStringOfType denv ty), m, m2))
+    }
 
 
 and SolveTypeChoice (csenv: ConstraintSolverEnv) ndeep m2 trace ty choiceTys =

src/Compiler/Checking/import.fs

@@ -459,16 +459,24 @@ let ImportILGenericParameters amap m scoref tinst (gps: ILGenericParameterDefs)
     match gps with 
     | [] -> []
     | _ -> 
-        let amap = amap()
+        let amap : ImportMap = amap()
         let tps = gps |> List.map (fun gp -> Construct.NewRigidTypar gp.Name m) 
 
         let tptys = tps |> List.map mkTyparTy
         let importInst = tinst@tptys
         (tps, gps) ||> List.iter2 (fun tp gp -> 
-            let constraints = gp.Constraints |> List.map (fun ilTy -> TyparConstraint.CoercesTo(ImportILType amap m importInst (rescopeILType scoref ilTy), m) )
-            let constraints = if gp.HasReferenceTypeConstraint then (TyparConstraint.IsReferenceType(m) :: constraints) else constraints
-            let constraints = if gp.HasNotNullableValueTypeConstraint then (TyparConstraint.IsNonNullableStruct(m) :: constraints) else constraints
-            let constraints = if gp.HasDefaultConstructorConstraint then (TyparConstraint.RequiresDefaultConstructor(m) :: constraints) else constraints
+            let constraints = 
+                [ if gp.CustomAttrs |> TryFindILAttribute amap.g.attrib_IsUnmanagedAttribute then
+                    TyparConstraint.IsUnmanaged(m)
+                  if gp.HasDefaultConstructorConstraint then
+                    TyparConstraint.RequiresDefaultConstructor(m)
+                  if gp.HasNotNullableValueTypeConstraint then
+                    TyparConstraint.IsNonNullableStruct(m)
+                  if gp.HasReferenceTypeConstraint then
+                    TyparConstraint.IsReferenceType(m)
+                  for ilTy in gp.Constraints do
+                    TyparConstraint.CoercesTo(ImportILType amap m importInst (rescopeILType scoref ilTy), m) ]            
+
             tp.SetConstraints constraints)
         tps
 

src/Compiler/CodeGen/IlxGen.fs

@@ -5555,7 +5555,7 @@ and GenGenericParam cenv eenv (tp: Typar) =
     let refTypeConstraint =
         tp.Constraints
         |> List.exists (function
-            | TyparConstraint.IsReferenceType _ -> true
+            | TyparConstraint.IsReferenceType _
             | TyparConstraint.SupportsNull _ -> true
             | _ -> false)
 
@@ -5571,6 +5571,13 @@ and GenGenericParam cenv eenv (tp: Typar) =
             | TyparConstraint.RequiresDefaultConstructor _ -> true
             | _ -> false)
 
+    let emitUnmanagedInIlOutput =
+        cenv.g.langVersion.SupportsFeature(LanguageFeature.UnmanagedConstraintCsharpInterop)
+        && tp.Constraints
+           |> List.exists (function
+               | TyparConstraint.IsUnmanaged _ -> true
+               | _ -> false)
+
     let tpName =
         // use the CompiledName if given
         // Inference variables get given an IL name "TA, TB" etc.
@@ -5598,16 +5605,31 @@ and GenGenericParam cenv eenv (tp: Typar) =
         else
             nm
 
-    let tpAttrs = mkILCustomAttrs (GenAttrs cenv eenv tp.Attribs)
+    let attributeList =
+        let defined = GenAttrs cenv eenv tp.Attribs
+
+        if emitUnmanagedInIlOutput then
+            (GetIsUnmanagedAttribute g) :: defined
+        else
+            defined
+
+    let tpAttrs = mkILCustomAttrs (attributeList)
+
+    let modreqValueType () =
+        ILType.Modified(true, g.iltyp_UnmanagedType.TypeRef, g.iltyp_ValueType)
 
     {
         Name = tpName
-        Constraints = subTypeConstraints
+        Constraints =
+            if emitUnmanagedInIlOutput then
+                (modreqValueType () :: subTypeConstraints)
+            else
+                subTypeConstraints
         Variance = NonVariant
         CustomAttrsStored = storeILCustomAttrs tpAttrs
         MetadataIndex = NoMetadataIdx
         HasReferenceTypeConstraint = refTypeConstraint
-        HasNotNullableValueTypeConstraint = notNullableValueTypeConstraint
+        HasNotNullableValueTypeConstraint = notNullableValueTypeConstraint || emitUnmanagedInIlOutput
         HasDefaultConstructorConstraint = defaultConstructorConstraint
     }
 

src/Compiler/CodeGen/IlxGenSupport.fs

@@ -155,10 +155,16 @@ let mkLocalPrivateInt32Enum (g: TcGlobals, tref: ILTypeRef, values: (string * in
 // Generate Local embeddable versions of framework types when necessary
 //--------------------------------------------------------------------------
 
-let GetReadOnlyAttribute (g: TcGlobals) =
-    let tref = g.attrib_IsReadOnlyAttribute.TypeRef
+let private getPotentiallyEmbedableAttribute (g: TcGlobals) (info: BuiltinAttribInfo) =
+    let tref = info.TypeRef
     g.TryEmbedILType(tref, (fun () -> mkLocalPrivateAttributeWithDefaultConstructor (g, tref.Name)))
-    mkILCustomAttribute (g.attrib_IsReadOnlyAttribute.TypeRef, [], [], [])
+    mkILCustomAttribute (info.TypeRef, [], [], [])
+
+let GetReadOnlyAttribute (g: TcGlobals) =
+    getPotentiallyEmbedableAttribute g g.attrib_IsReadOnlyAttribute
+
+let GetIsUnmanagedAttribute (g: TcGlobals) =
+    getPotentiallyEmbedableAttribute g g.attrib_IsUnmanagedAttribute
 
 let GenReadOnlyAttributeIfNecessary g ty =
     if isInByrefTy g ty then

src/Compiler/CodeGen/IlxGenSupport.fsi

@@ -21,3 +21,4 @@ val GetDynamicDependencyAttribute: g: TcGlobals -> memberTypes: int32 -> ilType:
 val GenReadOnlyModReqIfNecessary: g: TcGlobals -> ty: TypedTree.TType -> ilTy: ILType -> ILType
 val GenReadOnlyAttributeIfNecessary: g: TcGlobals -> ty: TypedTree.TType -> ILAttribute option
 val GetReadOnlyAttribute: g: TcGlobals -> ILAttribute
+val GetIsUnmanagedAttribute: g: TcGlobals -> ILAttribute

src/Compiler/FSComp.txt

@@ -318,6 +318,7 @@ csTypeDoesNotSupportConversion,"The type '%s' does not support a conversion to t
 csMethodFoundButIsStatic,"The type '%s' has a method '%s' (full name '%s'), but the method is static"
 csMethodFoundButIsNotStatic,"The type '%s' has a method '%s' (full name '%s'), but the method is not static"
 472,csStructConstraintInconsistent,"The constraints 'struct' and 'not struct' are inconsistent"
+473,csUnmanagedConstraintInconsistent,"The constraints 'unmanaged' and 'not struct' are inconsistent"
 csTypeDoesNotHaveNull,"The type '%s' does not have 'null' as a proper value"
 csNullableTypeDoesNotHaveNull,"The type '%s' does not have 'null' as a proper value. To create a null value for a Nullable type use 'System.Nullable()'."
 csTypeDoesNotSupportComparison1,"The type '%s' does not support the 'comparison' constraint because it has the 'NoComparison' attribute"
@@ -1712,4 +1713,5 @@ featureAccessorFunctionShorthand,"underscore dot shorthand for accessor only fun
 3570,tcStaticBindingInExtrinsicAugmentation,"Static bindings cannot be added to extrinsic augmentations. Consider using a 'static member' instead."
 3571,pickleFsharpCoreBackwardsCompatible,"Newly added pickle state cannot be used in FSharp.Core, since it must be working in older compilers+tooling as well. The time window is at least 3 years after feature introduction. Violation: %s . Context: \n %s "
 3577,tcOverrideUsesMultipleArgumentsInsteadOfTuple,"This override takes a tuple instead of multiple arguments. Try to add an additional layer of parentheses at the method definition (e.g. 'member _.Foo((x, y))'), or remove parentheses at the abstract method declaration (e.g. 'abstract member Foo: 'a * 'b -> 'c')."
-3578,chkCopyUpdateSyntaxInAnonRecords,"This expression is an anonymous record, use {{|...|}} instead of {{...}}."
+featureUnmanagedConstraintCsharpInterop,"Interop between C#'s and F#'s unmanaged generic constraint (emit additional modreq)"
+3578,chkCopyUpdateSyntaxInAnonRecords,"This expression is an anonymous record, use {{|...|}} instead of {{...}}."

src/Compiler/Facilities/LanguageFeatures.fs

@@ -74,6 +74,7 @@ type LanguageFeature =
     | DiagnosticForObjInference
     | StaticLetInRecordsDusEmptyTypes
     | WarningWhenTailRecAttributeButNonTailRecUsage
+    | UnmanagedConstraintCsharpInterop
     | WhileBang
 
 /// LanguageVersion management
@@ -172,6 +173,7 @@ type LanguageVersion(versionText) =
                 LanguageFeature.WarningWhenTailRecAttributeButNonTailRecUsage, previewVersion
                 LanguageFeature.StaticLetInRecordsDusEmptyTypes, previewVersion
                 LanguageFeature.StrictIndentation, previewVersion
+                LanguageFeature.UnmanagedConstraintCsharpInterop, previewVersion
                 LanguageFeature.WhileBang, previewVersion
             ]
 
@@ -302,6 +304,7 @@ type LanguageVersion(versionText) =
         | LanguageFeature.StaticLetInRecordsDusEmptyTypes -> FSComp.SR.featureStaticLetInRecordsDusEmptyTypes ()
         | LanguageFeature.StrictIndentation -> FSComp.SR.featureStrictIndentation ()
         | LanguageFeature.WarningWhenTailRecAttributeButNonTailRecUsage -> FSComp.SR.featureChkNotTailRecursive ()
+        | LanguageFeature.UnmanagedConstraintCsharpInterop -> FSComp.SR.featureUnmanagedConstraintCsharpInterop ()
         | LanguageFeature.WhileBang -> FSComp.SR.featureWhileBang ()
 
     /// Get a version string associated with the given feature.

src/Compiler/Facilities/LanguageFeatures.fsi

@@ -64,6 +64,7 @@ type LanguageFeature =
     | DiagnosticForObjInference
     | StaticLetInRecordsDusEmptyTypes
     | WarningWhenTailRecAttributeButNonTailRecUsage
+    | UnmanagedConstraintCsharpInterop
     | WhileBang
 
 /// LanguageVersion management

src/Compiler/TypedTree/TcGlobals.fs

@@ -165,6 +165,8 @@ let tname_CompilerGeneratedAttribute = "System.Runtime.CompilerServices.Compiler
 [<Literal>]
 let tname_ReferenceAssemblyAttribute = "System.Runtime.CompilerServices.ReferenceAssemblyAttribute"
 [<Literal>]
+let tname_UnmanagedType = "System.Runtime.InteropServices.UnmanagedType"
+[<Literal>]
 let tname_DebuggableAttribute = "System.Diagnostics.DebuggableAttribute"
 [<Literal>]
 let tname_AsyncCallback = "System.AsyncCallback"
@@ -336,6 +338,7 @@ type TcGlobals(
   static let isInEmbeddableKnownSet name =
       match name with
       | "System.Runtime.CompilerServices.IsReadOnlyAttribute"
+      | "System.Runtime.CompilerServices.IsUnmanagedAttribute"
       | "System.Diagnostics.CodeAnalysis.DynamicDependencyAttribute"
       | "System.Diagnostics.CodeAnalysis.DynamicallyAccessedMemberTypes" -> true
       | _ -> false
@@ -1415,6 +1418,7 @@ type TcGlobals(
   member val iltyp_RuntimeMethodHandle = findSysILTypeRef tname_RuntimeMethodHandle |> mkILNonGenericValueTy
   member val iltyp_RuntimeTypeHandle   = findSysILTypeRef tname_RuntimeTypeHandle |> mkILNonGenericValueTy
   member val iltyp_ReferenceAssemblyAttributeOpt = tryFindSysILTypeRef tname_ReferenceAssemblyAttribute |> Option.map mkILNonGenericBoxedTy
+  member val iltyp_UnmanagedType   = findSysILTypeRef tname_UnmanagedType |> mkILNonGenericValueTy  
   member val attrib_AttributeUsageAttribute = findSysAttrib "System.AttributeUsageAttribute"
   member val attrib_ParamArrayAttribute = findSysAttrib "System.ParamArrayAttribute"
   member val attrib_IDispatchConstantAttribute = tryFindSysAttrib "System.Runtime.CompilerServices.IDispatchConstantAttribute"
@@ -1423,6 +1427,7 @@ type TcGlobals(
   // We use 'findSysAttrib' here because lookup on attribute is done by name comparison, and can proceed
   // even if the type is not found in a system assembly.
   member val attrib_IsReadOnlyAttribute = findOrEmbedSysPublicType "System.Runtime.CompilerServices.IsReadOnlyAttribute"
+  member val attrib_IsUnmanagedAttribute = findOrEmbedSysPublicType "System.Runtime.CompilerServices.IsUnmanagedAttribute"
   member val attrib_DynamicDependencyAttribute = findOrEmbedSysPublicType "System.Diagnostics.CodeAnalysis.DynamicDependencyAttribute"
   member val enum_DynamicallyAccessedMemberTypes = findOrEmbedSysPublicType "System.Diagnostics.CodeAnalysis.DynamicallyAccessedMemberTypes"
 

src/Compiler/TypedTree/TypedTreeOps.fs

@@ -809,6 +809,10 @@ let destAnyParTy g ty = ty |> stripTyEqns g |> (function TType_var (v, _) -> v |
 
 let destMeasureTy g ty = ty |> stripTyEqns g |> (function TType_measure m -> m | _ -> failwith "destMeasureTy: not a unit-of-measure type")
 
+let destAnonRecdTy g ty = ty |> stripTyEqns g |> (function TType_anon (anonInfo, tys) -> anonInfo, tys | _ -> failwith "destAnonRecdTy: not an anonymous record type")
+
+let destStructAnonRecdTy g ty = ty |> stripTyEqns g |> (function TType_anon (anonInfo, tys) when evalAnonInfoIsStruct anonInfo -> tys | _ -> failwith "destAnonRecdTy: not a struct anonymous record type")
+
 let isFunTy g ty = ty |> stripTyEqns g |> (function TType_fun _ -> true | _ -> false)
 
 let isForallTy g ty = ty |> stripTyEqns g |> (function TType_forall _ -> true | _ -> false)
@@ -825,6 +829,8 @@ let isStructAnonRecdTy g ty = ty |> stripTyEqns g |> (function TType_anon (anonI
 
 let isUnionTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _, _) -> tcref.IsUnionTycon | _ -> false)
 
+let isStructUnionTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _, _) -> tcref.IsUnionTycon && tcref.Deref.entity_flags.IsStructRecordOrUnionType | _ -> false)
+
 let isReprHiddenTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _, _) -> tcref.IsHiddenReprTycon | _ -> false)
 
 let isFSharpObjModelTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _, _) -> tcref.IsFSharpObjectModelTycon | _ -> false)
@@ -1957,22 +1963,23 @@ let isForallFunctionTy g ty =
     let _, tau = tryDestForallTy g ty
     isFunTy g tau
 
-// ECMA C# LANGUAGE SPECIFICATION, 27.2
 // An unmanaged-type is any type that isn't a reference-type, a type-parameter, or a generic struct-type and
 // contains no fields whose type is not an unmanaged-type. In other words, an unmanaged-type is one of the
 // following:
 // - sbyte, byte, short, ushort, int, uint, long, ulong, char, float, double, decimal, or bool.
 // - Any enum-type.
 // - Any pointer-type.
-// - Any non-generic user-defined struct-type that contains fields of unmanaged-types only.
-// [Note: Constructed types and type-parameters are never unmanaged-types. end note]
+// - Any generic user-defined struct-type that can be statically determined to be 'unmanaged' at construction.
 let rec isUnmanagedTy g ty =
+    let isUnmanagedRecordField tinst rf  =
+        isUnmanagedTy g (actualTyOfRecdField tinst rf)
+
     let ty = stripTyEqnsAndMeasureEqns g ty
     match tryTcrefOfAppTy g ty with
     | ValueSome tcref ->
-        let isEq tcref2 = tyconRefEq g tcref tcref2 
+        let isEq tcref2 = tyconRefEq g tcref tcref2
         if isEq g.nativeptr_tcr || isEq g.nativeint_tcr ||
-                    isEq g.sbyte_tcr || isEq g.byte_tcr || 
+                    isEq g.sbyte_tcr || isEq g.byte_tcr ||
                     isEq g.int16_tcr || isEq g.uint16_tcr ||
                     isEq g.int32_tcr || isEq g.uint32_tcr ||
                     isEq g.int64_tcr || isEq g.uint64_tcr ||
@@ -1984,15 +1991,24 @@ let rec isUnmanagedTy g ty =
             true
         else
             let tycon = tcref.Deref
-            if tycon.IsEnumTycon then 
+            if tycon.IsEnumTycon then
                 true
+            elif isStructUnionTy g ty then
+                let tinst = mkInstForAppTy g ty 
+                tcref.UnionCasesAsRefList            
+                |> List.forall (fun c -> c |> actualTysOfUnionCaseFields tinst |> List.forall (isUnmanagedTy g))
             elif tycon.IsStructOrEnumTycon then
-                match tycon.TyparsNoRange with
-                | [] -> tycon.AllInstanceFieldsAsList |> List.forall (fun r -> isUnmanagedTy g r.rfield_type) 
-                | _ -> false // generic structs are never 
+                let tinst = mkInstForAppTy g ty
+                tycon.AllInstanceFieldsAsList 
+                |> List.forall (isUnmanagedRecordField tinst)
             else false
     | ValueNone ->
-        false
+        if isStructTupleTy g ty then
+            (destStructTupleTy g ty) |> List.forall (isUnmanagedTy g)
+        else if isStructAnonRecdTy g ty then
+            (destStructAnonRecdTy g ty) |> List.forall (isUnmanagedTy g)
+        else
+            false
 
 let isInterfaceTycon x = 
     isILInterfaceTycon x || x.IsFSharpInterfaceTycon

src/Compiler/TypedTree/TypedTreeOps.fsi

@@ -633,6 +633,10 @@ val destAnyParTy: TcGlobals -> TType -> Typar
 
 val destMeasureTy: TcGlobals -> TType -> Measure
 
+val destAnonRecdTy: TcGlobals -> TType -> AnonRecdTypeInfo * TTypes
+
+val destStructAnonRecdTy: TcGlobals -> TType -> TTypes
+
 val tryDestForallTy: TcGlobals -> TType -> Typars * TType
 
 val isFunTy: TcGlobals -> TType -> bool
@@ -651,6 +655,8 @@ val isAnonRecdTy: TcGlobals -> TType -> bool
 
 val isUnionTy: TcGlobals -> TType -> bool
 
+val isStructUnionTy: TcGlobals -> TType -> bool
+
 val isReprHiddenTy: TcGlobals -> TType -> bool
 
 val isFSharpObjModelTy: TcGlobals -> TType -> bool