Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
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
Loading