Skip to content

Commit adb02dc

Browse files
authored
Bugfix:: Add missing codegen for mapping of overlapped struct DU fields and read it in fslib reflection (#18274)
1 parent 10b812b commit adb02dc

File tree

16 files changed

+230
-96
lines changed

16 files changed

+230
-96
lines changed

docs/release-notes/.FSharp.Compiler.Service/9.0.300.md

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -19,3 +19,4 @@
1919
* Remove `Cancellable.UsingToken` from tests ([PR #18276](https://github.com/dotnet/fsharp/pull/18276))
2020

2121
### Breaking Changes
22+
* Struct unions with overlapping fields now generate mappings needed for reading via reflection ([Issue #18121](https://github.com/dotnet/fsharp/issues/17797), [PR #18274](https://github.com/dotnet/fsharp/pull/17877))
Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
### Fixed
2+
3+
### Added
4+
5+
### Changed
6+
7+
### Breaking Changes
8+
* Struct unions with overlapping fields now generate mappings needed for reading via reflection ([Issue #18121](https://github.com/dotnet/fsharp/issues/17797), [PR #18274](https://github.com/dotnet/fsharp/pull/17877)). Previous versions of FSharp.Core returned incomplete mapping between fields and cases, these older fslib versions will now report an exception.

src/Compiler/AbstractIL/ilx.fsi

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -162,6 +162,8 @@ val mkILFormalCloRef: ILGenericParameterDefs -> IlxClosureRef -> useStaticField:
162162
// MS-ILX: Unions
163163
// --------------------------------------------------------------------
164164

165+
val mkLowerName: nm: string -> string
166+
165167
val actualTypOfIlxUnionField: IlxUnionSpec -> int -> int -> ILType
166168

167169
val mkILFreeVar: string * bool * ILType -> IlxClosureFreeVar

src/Compiler/CodeGen/IlxGen.fs

Lines changed: 40 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -601,6 +601,29 @@ let voidCheck m g permits ty =
601601
error (InternalError("System.Void unexpectedly detected in IL code generation. This should not occur.", m))
602602
#endif
603603

604+
[<Struct>]
605+
type DuFieldCoordinates = { CaseIdx: int; FieldIdx: int }
606+
607+
/// Structure for maintaining field reuse across struct unions
608+
type UnionFieldReuseMap = MultiMap<string, DuFieldCoordinates>
609+
610+
let unionFieldReuseMapping thisUnionTy (cases: UnionCase[]) : UnionFieldReuseMap =
611+
612+
if not (isStructTyconRef thisUnionTy) then
613+
Map.empty
614+
else
615+
let fieldKey (f: RecdField) = mkLowerName f.LogicalName
616+
617+
[
618+
for i = 0 to cases.Length - 1 do
619+
let fields = cases[i].RecdFieldsArray
620+
621+
for j = 0 to fields.Length - 1 do
622+
let f = fields[j]
623+
yield fieldKey f, { CaseIdx = i; FieldIdx = j }
624+
]
625+
|> MultiMap.ofList
626+
604627
/// When generating parameter and return types generate precise .NET IL pointer types.
605628
/// These can't be generated for generic instantiations, since .NET generics doesn't
606629
/// permit this. But for 'naked' values (locals, parameters, return values etc.) machine
@@ -702,18 +725,24 @@ and GenTypeAux cenv m (tyenv: TypeReprEnv) voidOK ptrsOK ty =
702725
//--------------------------------------------------------------------------
703726
// Generate ILX references to closures, classunions etc. given a tyenv
704727
//--------------------------------------------------------------------------
705-
706-
and GenUnionCaseRef (cenv: cenv) m tyenv i (fspecs: RecdField[]) =
728+
and GenUnionCaseRef (cenv: cenv) m tyenv (reuseMap: UnionFieldReuseMap) i (fspecs: RecdField[]) =
707729
let g = cenv.g
708730

731+
let fieldMarker = int SourceConstructFlags.Field
732+
709733
fspecs
710734
|> Array.mapi (fun j fspec ->
711735
let ilFieldDef =
712736
mkILInstanceField (fspec.LogicalName, GenType cenv m tyenv fspec.FormalType, None, ILMemberAccess.Public)
713737
// These properties on the "field" of an alternative end up going on a property generated by cu_erase.fs
714-
let attrs =
715-
(mkCompilationMappingAttrWithVariantNumAndSeqNum g (int SourceConstructFlags.Field) i j)
716-
:: GenAdditionalAttributesForTy g fspec.FormalType
738+
let mappingAttrs =
739+
match reuseMap |> MultiMap.find (mkLowerName fspec.LogicalName) with
740+
| [] -> [ mkCompilationMappingAttrWithVariantNumAndSeqNum g fieldMarker i j ]
741+
| mappings ->
742+
mappings
743+
|> List.map (fun m -> mkCompilationMappingAttrWithVariantNumAndSeqNum g fieldMarker m.CaseIdx m.FieldIdx)
744+
745+
let attrs = mappingAttrs @ GenAdditionalAttributesForTy g fspec.FormalType
717746

718747
IlxUnionCaseField(ilFieldDef.With(customAttrs = mkILCustomAttrs attrs)))
719748

@@ -731,13 +760,15 @@ and GenUnionRef (cenv: cenv) m (tcref: TyconRef) =
731760
match tcref.CompiledRepresentation with
732761
| CompiledTypeRepr.ILAsmOpen _ -> failwith "GenUnionRef m: unexpected ASM tyrep"
733762
| CompiledTypeRepr.ILAsmNamed(tref, _, _) ->
763+
let fieldReuseMap = unionFieldReuseMapping tcref tycon.UnionCasesArray
764+
734765
let alternatives =
735766
tycon.UnionCasesArray
736767
|> Array.mapi (fun i cspec ->
737768
{
738769
altName = cspec.CompiledName
739770
altCustomAttrs = emptyILCustomAttrs
740-
altFields = GenUnionCaseRef cenv m tyenvinner i cspec.RecdFieldsArray
771+
altFields = GenUnionCaseRef cenv m tyenvinner fieldReuseMap i cspec.RecdFieldsArray
741772
})
742773

743774
let nullPermitted = IsUnionTypeWithNullAsTrueValue g tycon
@@ -11658,11 +11689,13 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option
1165811689
| _ -> false)
1165911690
->
1166011691
let alternatives =
11692+
let fieldReuseMap = unionFieldReuseMapping tcref tycon.UnionCasesArray
11693+
1166111694
tycon.UnionCasesArray
1166211695
|> Array.mapi (fun i ucspec ->
1166311696
{
1166411697
altName = ucspec.CompiledName
11665-
altFields = GenUnionCaseRef cenv m eenvinner.tyenv i ucspec.RecdFieldsArray
11698+
altFields = GenUnionCaseRef cenv m eenvinner.tyenv fieldReuseMap i ucspec.RecdFieldsArray
1166611699
altCustomAttrs =
1166711700
mkILCustomAttrs (
1166811701
GenAttrs cenv eenv ucspec.Attribs

src/Compiler/TypedTree/TypedTreeOps.fs

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -8337,9 +8337,6 @@ let IsMatchingSignatureDataVersionAttr (version: ILVersionInfo) cattr =
83378337
warning(Failure(FSComp.SR.tastUnexpectedDecodeOfInterfaceDataVersionAttribute()))
83388338
false
83398339

8340-
let mkCompilerGeneratedAttr (g: TcGlobals) n =
8341-
mkILCustomAttribute (tref_CompilationMappingAttr g, [mkILNonGenericValueTy (tref_SourceConstructFlags g)], [ILAttribElem.Int32 n], [])
8342-
83438340
//--------------------------------------------------------------------------
83448341
// tupled lambda --> method/function with a given valReprInfo specification.
83458342
//

src/Compiler/TypedTree/TypedTreeOps.fsi

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2380,8 +2380,6 @@ val mkCompilationSourceNameAttr: TcGlobals -> string -> ILAttribute
23802380

23812381
val mkSignatureDataVersionAttr: TcGlobals -> ILVersionInfo -> ILAttribute
23822382

2383-
val mkCompilerGeneratedAttr: TcGlobals -> int -> ILAttribute
2384-
23852383
//-------------------------------------------------------------------------
23862384
// More common type construction
23872385
//-------------------------------------------------------------------------

src/Compiler/Utilities/illib.fs

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1307,6 +1307,14 @@ module MultiMap =
13071307
let initBy f xs : MultiMap<_, _> =
13081308
xs |> Seq.groupBy f |> Seq.map (fun (k, v) -> (k, List.ofSeq v)) |> Map.ofSeq
13091309

1310+
let ofList (xs: ('a * 'b) list) : MultiMap<'a,'b> =
1311+
(Map.empty, xs)
1312+
||> List.fold (fun m (k, v) ->
1313+
m |> Map.change k (function
1314+
| None -> Some [v]
1315+
| Some vs -> Some (v :: vs)))
1316+
|> Map.map (fun _ values -> List.rev values)
1317+
13101318
type LayeredMap<'Key, 'Value when 'Key: comparison> = Map<'Key, 'Value>
13111319

13121320
[<AutoOpen>]

src/Compiler/Utilities/illib.fsi

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -570,6 +570,8 @@ module internal MultiMap =
570570

571571
val initBy: f: ('a -> 'b) -> xs: seq<'a> -> MultiMap<'b, 'a> when 'b: comparison
572572

573+
val ofList: xs: ('a * 'b) list -> MultiMap<'a,'b> when 'a: comparison
574+
573575
type internal LayeredMap<'Key, 'Value when 'Key: comparison> = Map<'Key, 'Value>
574576

575577
[<AutoOpen>]

src/FSharp.Core/prim-types.fs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -221,7 +221,7 @@ namespace Microsoft.FSharp.Core
221221
member _.Minor = minor
222222
member _.Release = release
223223

224-
[<AttributeUsage(AttributeTargets.All, AllowMultiple=false)>]
224+
[<AttributeUsage(AttributeTargets.All, AllowMultiple=true)>]
225225
[<Sealed>]
226226
type CompilationMappingAttribute(sourceConstructFlags:SourceConstructFlags,
227227
variantNumber:int,

src/FSharp.Core/prim-types.fsi

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -657,7 +657,7 @@ namespace Microsoft.FSharp.Core
657657
/// their original forms. It is not intended for use from user code.</remarks>
658658
///
659659
/// <category>Attributes</category>
660-
[<AttributeUsage (AttributeTargets.All,AllowMultiple=false)>]
660+
[<AttributeUsage (AttributeTargets.All,AllowMultiple=true)>]
661661
[<Sealed>]
662662
type CompilationMappingAttribute =
663663
inherit Attribute

0 commit comments

Comments
 (0)