Skip to content

Commit

Permalink
Nullness :: Bugfix :: Codegen missing metadata for C# consumers (reco…
Browse files Browse the repository at this point in the history
…rds,DUs,exceptions) (#18079)
  • Loading branch information
T-Gro authored Dec 6, 2024
1 parent b204b96 commit a90f6d1
Show file tree
Hide file tree
Showing 153 changed files with 3,962 additions and 4,740 deletions.
1 change: 1 addition & 0 deletions docs/release-notes/.FSharp.Compiler.Service/9.0.200.md
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@
* Fix failure to use bound values in `when` clauses of `try-with` in `seq` expressions ([PR #17990](https://github.com/dotnet/fsharp/pull/17990))
* Fix locals allocating for the special `copyOfStruct` defensive copy ([PR #18025](https://github.com/dotnet/fsharp/pull/18025))
* Fix lowering of computed array expressions when the expression consists of a simple mapping from a `uint64` or `unativeint` array. [PR #18081](https://github.com/dotnet/fsharp/pull/18081)
* Add missing nullable-metadata for C# consumers of records,exceptions and DU subtypes generated from F# code. [PR #18079](https://github.com/dotnet/fsharp/pull/18079)


### Added
Expand Down
17 changes: 14 additions & 3 deletions src/Compiler/AbstractIL/il.fs
Original file line number Diff line number Diff line change
Expand Up @@ -4208,14 +4208,25 @@ let mkILStorageCtorWithParamNames (preblock: ILInstr list, ty, extraParams, flds
| Some x -> I_seqpoint x
| None -> ()
yield! preblock
for (n, (_pnm, nm, fieldTy)) in List.indexed flds do
for (n, (_pnm, nm, fieldTy,_attrs)) in List.indexed flds do
mkLdarg0
mkLdarg (uint16 (n + 1))
mkNormalStfld (mkILFieldSpecInTy (ty, nm, fieldTy))
]

let body = mkMethodBody (false, [], 2, nonBranchingInstrsToCode code, tag, imports)
mkILCtor (access, (flds |> List.map (fun (pnm, _, ty) -> mkILParamNamed (pnm, ty))) @ extraParams, body)
let fieldParams =
[
for (pnm,_,ty,attrs) in flds do
let ilParam = mkILParamNamed (pnm, ty)
let ilParam =
match attrs with
| [] -> ilParam
| attrs -> {ilParam with CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrs attrs ) }
yield ilParam
]

mkILCtor (access, fieldParams @ extraParams , body)

let mkILSimpleStorageCtorWithParamNames (baseTySpec, ty, extraParams, flds, access, tag, imports) =
let preblock =
Expand All @@ -4226,7 +4237,7 @@ let mkILSimpleStorageCtorWithParamNames (baseTySpec, ty, extraParams, flds, acce
mkILStorageCtorWithParamNames (preblock, ty, extraParams, flds, access, tag, imports)

let addParamNames flds =
flds |> List.map (fun (nm, ty) -> (nm, nm, ty))
flds |> List.map (fun (nm, ty, attrs) -> (nm, nm, ty, attrs))

let mkILSimpleStorageCtor (baseTySpec, ty, extraParams, flds, access, tag, imports) =
mkILSimpleStorageCtorWithParamNames (baseTySpec, ty, extraParams, addParamNames flds, access, tag, imports)
Expand Down
11 changes: 8 additions & 3 deletions src/Compiler/AbstractIL/il.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -2217,14 +2217,19 @@ val internal prependInstrsToClassCtor:

/// Derived functions for making some simple constructors
val internal mkILStorageCtor:
ILInstr list * ILType * (string * ILType) list * ILMemberAccess * ILDebugPoint option * ILDebugImports option ->
ILInstr list *
ILType *
(string * ILType * ILAttribute list) list *
ILMemberAccess *
ILDebugPoint option *
ILDebugImports option ->
ILMethodDef

val internal mkILSimpleStorageCtor:
ILTypeSpec option *
ILType *
ILParameter list *
(string * ILType) list *
(string * ILType * ILAttribute list) list *
ILMemberAccess *
ILDebugPoint option *
ILDebugImports option ->
Expand All @@ -2234,7 +2239,7 @@ val internal mkILSimpleStorageCtorWithParamNames:
ILTypeSpec option *
ILType *
ILParameter list *
(string * string * ILType) list *
(string * string * ILType * ILAttribute list) list *
ILMemberAccess *
ILDebugPoint option *
ILDebugImports option ->
Expand Down
4 changes: 2 additions & 2 deletions src/Compiler/CodeGen/EraseClosures.fs
Original file line number Diff line number Diff line change
Expand Up @@ -560,7 +560,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo =
mkILStorageCtor (
[ mkLdarg0; mkNormalCall (mkILCtorMethSpecForTy (cenv.mkILTyFuncTy, [])) ],
nowTy,
mkILCloFldSpecs cenv nowFields,
mkILCloFldSpecs cenv nowFields |> List.map (fun (name, t) -> (name, t, [])),
ILMemberAccess.Assembly,
None,
None
Expand Down Expand Up @@ -695,7 +695,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo =
mkILStorageCtor (
[ mkLdarg0; mkNormalCall (mkILCtorMethSpecForTy (nowEnvParentClass, [])) ],
nowTy,
mkILCloFldSpecs cenv nowFields,
mkILCloFldSpecs cenv nowFields |> List.map (fun (name, t) -> (name, t, [])),
ILMemberAccess.Assembly,
None,
cloImports
Expand Down
78 changes: 50 additions & 28 deletions src/Compiler/CodeGen/EraseUnions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -214,6 +214,18 @@ let mkUnionCaseFieldId (fdef: IlxUnionCaseField) =
// Use the lower case name of a field or constructor as the field/parameter name if it differs from the uppercase name
fdef.LowerName, fdef.Type

let inline getFieldsNullability (g: TcGlobals) (ilf: ILFieldDef) =
if g.checkNullness then
ilf.CustomAttrs.AsArray()
|> Array.tryFind (IsILAttrib g.attrib_NullableAttribute)
else
None

let mkUnionCaseFieldIdAndAttrs g fdef =
let nm, t = mkUnionCaseFieldId fdef
let attrs = getFieldsNullability g fdef.ILField
nm, t, attrs |> Option.toList

let refToFieldInTy ty (nm, fldTy) = mkILFieldSpecInTy (ty, nm, fldTy)

let formalTypeArgs (baseTy: ILType) =
Expand Down Expand Up @@ -711,14 +723,9 @@ let mkMethodsAndPropertiesForFields
let ilReturn = mkILReturn field.Type

let ilReturn =
if TryFindILAttribute g.attrib_NullableAttribute field.ILField.CustomAttrs then
let attrs =
field.ILField.CustomAttrs.AsArray()
|> Array.filter (IsILAttrib g.attrib_NullableAttribute)

ilReturn.WithCustomAttrs(mkILCustomAttrsFromArray attrs)
else
ilReturn
match getFieldsNullability g field.ILField with
| None -> ilReturn
| Some a -> ilReturn.WithCustomAttrs(mkILCustomAttrsFromArray [| a |])

yield
mkILNonGenericInstanceMethod (
Expand Down Expand Up @@ -808,22 +815,19 @@ let convAlternativeDef
|> Array.map (fun fd ->
let plainParam = mkILParamNamed (fd.LowerName, fd.Type)

if TryFindILAttribute g.attrib_NullableAttribute fd.ILField.CustomAttrs then
let attrs =
fd.ILField.CustomAttrs.AsArray()
|> Array.filter (IsILAttrib g.attrib_NullableAttribute)

match getFieldsNullability g fd.ILField with
| None -> plainParam
| Some a ->
{ plainParam with
CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrsFromArray attrs)
}
else
plainParam)
CustomAttrsStored = storeILCustomAttrs (mkILCustomAttrsFromArray [| a |])
})

|> Array.toList,
mkILReturn baseTy,
mkMethodBody (true, locals, fields.Length + locals.Length, nonBranchingInstrsToCode ilInstrs, attr, imports)
)
|> addMethodGeneratedAttrs
|> addAltAttribs
|> addMethodGeneratedAttrs

mdef

Expand Down Expand Up @@ -984,8 +988,8 @@ let convAlternativeDef
imports
)
)
|> addMethodGeneratedAttrs
|> addAltAttribs
|> addMethodGeneratedAttrs

let nullaryProp =

Expand Down Expand Up @@ -1158,14 +1162,19 @@ let convAlternativeDef
let basicFields =
fields
|> Array.map (fun field ->
let fldName, fldTy = mkUnionCaseFieldId field
let fldName, fldTy, attrs = mkUnionCaseFieldIdAndAttrs g field
let fdef = mkILInstanceField (fldName, fldTy, None, ILMemberAccess.Assembly)

let fdef =
mkILInstanceField (fldName, fldTy, None, ILMemberAccess.Assembly)
match attrs with
| [] -> fdef
| attrs -> fdef.With(customAttrs = mkILCustomAttrs attrs)

|> addFieldNeverAttrs
|> addFieldGeneratedAttrs

fdef.WithInitOnly(isTotallyImmutable))

|> Array.toList

let basicProps, basicMethods =
Expand Down Expand Up @@ -1198,7 +1207,11 @@ let convAlternativeDef
cud.UnionCasesAccessibility)

let basicCtorFields =
basicFields |> List.map (fun fdef -> fdef.Name, fdef.FieldType)
basicFields
|> List.map (fun fdef ->
let existingAttrs = fdef.CustomAttrs.AsArray()
let nullableAttr = getFieldsNullability g fdef |> Option.toList
fdef.Name, fdef.FieldType, nullableAttr)

let basicCtorMeth =
(mkILStorageCtor (basicCtorInstrs, altTy, basicCtorFields, basicCtorAccess, attr, imports))
Expand Down Expand Up @@ -1295,7 +1308,7 @@ let mkClassUnionDef
| SingleCase
| RuntimeTypes
| TailOrNull -> []
| IntegerTag -> [ mkTagFieldId g.ilg cuspec ]
| IntegerTag -> [ let n, t = mkTagFieldId g.ilg cuspec in n, t, [] ]

let isStruct = td.IsStruct

Expand All @@ -1320,8 +1333,6 @@ let mkClassUnionDef
repr.RepresentAlternativeAsFreshInstancesOfRootClass(info, alt)
|| repr.RepresentAlternativeAsStructValue info
then
// TODO
let fields = alt.FieldDefs |> Array.map mkUnionCaseFieldId |> Array.toList

let baseInit =
if isStruct then
Expand All @@ -1337,6 +1348,9 @@ let mkClassUnionDef
if isStruct && not (cidx = minNullaryIdx) then
[]
else
let fields =
alt.FieldDefs |> Array.map (mkUnionCaseFieldIdAndAttrs g) |> Array.toList

[
(mkILSimpleStorageCtor (
baseInit,
Expand Down Expand Up @@ -1406,7 +1420,10 @@ let mkClassUnionDef
fieldDefs
|> Array.filter (fun f -> fieldsEmitted.Add(struct (f.LowerName, f.Type)))

let fields = fieldsToBeAddedIntoType |> Array.map mkUnionCaseFieldId |> Array.toList
let fields =
fieldsToBeAddedIntoType
|> Array.map (mkUnionCaseFieldIdAndAttrs g)
|> Array.toList

let props, meths =
mkMethodsAndPropertiesForFields
Expand All @@ -1426,9 +1443,14 @@ let mkClassUnionDef

let selfAndTagFields =
[
for fldName, fldTy in (selfFields @ tagFieldsInObject) do
for fldName, fldTy, attrs in (selfFields @ tagFieldsInObject) do
let fdef =
mkILInstanceField (fldName, fldTy, None, ILMemberAccess.Assembly)
let fdef = mkILInstanceField (fldName, fldTy, None, ILMemberAccess.Assembly)

match attrs with
| [] -> fdef
| attrs -> fdef.With(customAttrs = mkILCustomAttrs attrs)

|> addFieldNeverAttrs
|> addFieldGeneratedAttrs

Expand Down
Loading

0 comments on commit a90f6d1

Please sign in to comment.