From 495ab1c95a1e464dfedce3bc61e1f87cb6a2be9a Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 20 Feb 2026 18:29:58 +0100 Subject: [PATCH 01/71] Define WellKnownILAttributes, WellKnownEntityAttributes, WellKnownValAttributes flag enums MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add three [] enums for O(1) well-known attribute lookups: - WellKnownILAttributes (uint32) in AbstractIL/il.fs/.fsi - WellKnownEntityAttributes (uint64) in TypedTree/TypedTree.fs/.fsi - WellKnownValAttributes (uint64) in TypedTree/TypedTree.fs/.fsi Each enum uses power-of-2 bit values with NotComputed at the sign bit. Purely additive — no existing code modified. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/AbstractIL/il.fs | 24 +++++++++++ src/Compiler/AbstractIL/il.fsi | 24 +++++++++++ src/Compiler/TypedTree/TypedTree.fs | 62 ++++++++++++++++++++++++++++ src/Compiler/TypedTree/TypedTree.fsi | 62 ++++++++++++++++++++++++++++ 4 files changed, 172 insertions(+) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index 5d7848f246e..77605454840 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -1229,6 +1229,30 @@ type ILAttributes(array: ILAttribute[]) = static member val internal Empty = ILAttributes([||]) +[] +type WellKnownILAttributes = + | None = 0u + | IsReadOnlyAttribute = 0x1u + | IsUnmanagedAttribute = 0x2u + | IsByRefLikeAttribute = 0x4u + | ExtensionAttribute = 0x8u + | NullableAttribute = 0x10u + | ParamArrayAttribute = 0x20u + | AllowNullLiteralAttribute = 0x40u + | ReflectedDefinitionAttribute = 0x80u + | AutoOpenAttribute = 0x100u + | InternalsVisibleToAttribute = 0x200u + | CallerMemberNameAttribute = 0x400u + | CallerFilePathAttribute = 0x800u + | CallerLineNumberAttribute = 0x1000u + | IDispatchConstantAttribute = 0x2000u + | IUnknownConstantAttribute = 0x4000u + | RequiresLocationAttribute = 0x8000u + | SetsRequiredMembersAttribute = 0x10000u + | NoEagerConstraintApplicationAttribute = 0x20000u + | DefaultMemberAttribute = 0x40000u + | NotComputed = 0x80000000u + [] type ILAttributesStored = diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index 3d6f88bb6ca..ec78eb04a5a 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -878,6 +878,30 @@ type ILAttributes = static member internal Empty: ILAttributes +[] +type WellKnownILAttributes = + | None = 0u + | IsReadOnlyAttribute = 0x1u + | IsUnmanagedAttribute = 0x2u + | IsByRefLikeAttribute = 0x4u + | ExtensionAttribute = 0x8u + | NullableAttribute = 0x10u + | ParamArrayAttribute = 0x20u + | AllowNullLiteralAttribute = 0x40u + | ReflectedDefinitionAttribute = 0x80u + | AutoOpenAttribute = 0x100u + | InternalsVisibleToAttribute = 0x200u + | CallerMemberNameAttribute = 0x400u + | CallerFilePathAttribute = 0x800u + | CallerLineNumberAttribute = 0x1000u + | IDispatchConstantAttribute = 0x2000u + | IUnknownConstantAttribute = 0x4000u + | RequiresLocationAttribute = 0x8000u + | SetsRequiredMembersAttribute = 0x10000u + | NoEagerConstraintApplicationAttribute = 0x20000u + | DefaultMemberAttribute = 0x40000u + | NotComputed = 0x80000000u + /// Represents the efficiency-oriented storage of ILAttributes in another item. [] type ILAttributesStored = diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index b08823c2734..4e641fc56cb 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -4627,6 +4627,68 @@ type Measure = | One(range= m) -> m | RationalPower(measure= ms) -> ms.Range +[] +type WellKnownEntityAttributes = + | None = 0UL + | RequireQualifiedAccessAttribute = 0x1UL + | AutoOpenAttribute = 0x2UL + | AbstractClassAttribute = 0x4UL + | SealedAttribute = 0x8UL + | NoEqualityAttribute = 0x10UL + | NoComparisonAttribute = 0x20UL + | StructuralEqualityAttribute = 0x40UL + | StructuralComparisonAttribute = 0x80UL + | CustomEqualityAttribute = 0x100UL + | CustomComparisonAttribute = 0x200UL + | ReferenceEqualityAttribute = 0x400UL + | DefaultAugmentationAttribute = 0x800UL + | CLIMutableAttribute = 0x1000UL + | AutoSerializableAttribute = 0x2000UL + | StructLayoutAttribute = 0x4000UL + | DllImportAttribute = 0x8000UL + | ReflectedDefinitionAttribute = 0x10000UL + | GeneralizableValueAttribute = 0x20000UL + | SkipLocalsInitAttribute = 0x40000UL + | DebuggerTypeProxyAttribute = 0x80000UL + | ComVisibleAttribute = 0x100000UL + | IsReadOnlyAttribute = 0x200000UL + | IsByRefLikeAttribute = 0x400000UL + | ExtensionAttribute = 0x800000UL + | AttributeUsageAttribute = 0x1000000UL + | WarnOnWithoutNullArgumentAttribute = 0x2000000UL + | AllowNullLiteralAttribute = 0x4000000UL + | NotComputed = 0x8000000000000000UL + +[] +type WellKnownValAttributes = + | None = 0UL + | DllImportAttribute = 0x1UL + | EntryPointAttribute = 0x2UL + | LiteralAttribute = 0x4UL + | ConditionalAttribute = 0x8UL + | ReflectedDefinitionAttribute = 0x10UL + | RequiresExplicitTypeArgumentsAttribute = 0x20UL + | DefaultValueAttribute = 0x40UL + | SkipLocalsInitAttribute = 0x80UL + | ThreadStaticAttribute = 0x100UL + | ContextStaticAttribute = 0x200UL + | VolatileFieldAttribute = 0x400UL + | NoDynamicInvocationAttribute = 0x800UL + | ExtensionAttribute = 0x1000UL + | OptionalArgumentAttribute = 0x2000UL + | InAttribute = 0x4000UL + | OutAttribute = 0x8000UL + | ParamArrayAttribute = 0x10000UL + | CallerMemberNameAttribute = 0x20000UL + | CallerFilePathAttribute = 0x40000UL + | CallerLineNumberAttribute = 0x80000UL + | DefaultParameterValueAttribute = 0x100000UL + | ProjectionParameterAttribute = 0x200000UL + | InlineIfLambdaAttribute = 0x400000UL + | OptionalAttribute = 0x800000UL + | StructAttribute = 0x1000000UL + | NotComputed = 0x8000000000000000UL + type Attribs = Attrib list [] diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index 3fe7c5b1c90..49c0f96df36 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -3234,6 +3234,68 @@ type Measure = member Range: range +[] +type WellKnownEntityAttributes = + | None = 0UL + | RequireQualifiedAccessAttribute = 0x1UL + | AutoOpenAttribute = 0x2UL + | AbstractClassAttribute = 0x4UL + | SealedAttribute = 0x8UL + | NoEqualityAttribute = 0x10UL + | NoComparisonAttribute = 0x20UL + | StructuralEqualityAttribute = 0x40UL + | StructuralComparisonAttribute = 0x80UL + | CustomEqualityAttribute = 0x100UL + | CustomComparisonAttribute = 0x200UL + | ReferenceEqualityAttribute = 0x400UL + | DefaultAugmentationAttribute = 0x800UL + | CLIMutableAttribute = 0x1000UL + | AutoSerializableAttribute = 0x2000UL + | StructLayoutAttribute = 0x4000UL + | DllImportAttribute = 0x8000UL + | ReflectedDefinitionAttribute = 0x10000UL + | GeneralizableValueAttribute = 0x20000UL + | SkipLocalsInitAttribute = 0x40000UL + | DebuggerTypeProxyAttribute = 0x80000UL + | ComVisibleAttribute = 0x100000UL + | IsReadOnlyAttribute = 0x200000UL + | IsByRefLikeAttribute = 0x400000UL + | ExtensionAttribute = 0x800000UL + | AttributeUsageAttribute = 0x1000000UL + | WarnOnWithoutNullArgumentAttribute = 0x2000000UL + | AllowNullLiteralAttribute = 0x4000000UL + | NotComputed = 0x8000000000000000UL + +[] +type WellKnownValAttributes = + | None = 0UL + | DllImportAttribute = 0x1UL + | EntryPointAttribute = 0x2UL + | LiteralAttribute = 0x4UL + | ConditionalAttribute = 0x8UL + | ReflectedDefinitionAttribute = 0x10UL + | RequiresExplicitTypeArgumentsAttribute = 0x20UL + | DefaultValueAttribute = 0x40UL + | SkipLocalsInitAttribute = 0x80UL + | ThreadStaticAttribute = 0x100UL + | ContextStaticAttribute = 0x200UL + | VolatileFieldAttribute = 0x400UL + | NoDynamicInvocationAttribute = 0x800UL + | ExtensionAttribute = 0x1000UL + | OptionalArgumentAttribute = 0x2000UL + | InAttribute = 0x4000UL + | OutAttribute = 0x8000UL + | ParamArrayAttribute = 0x10000UL + | CallerMemberNameAttribute = 0x20000UL + | CallerFilePathAttribute = 0x40000UL + | CallerLineNumberAttribute = 0x80000UL + | DefaultParameterValueAttribute = 0x100000UL + | ProjectionParameterAttribute = 0x200000UL + | InlineIfLambdaAttribute = 0x400000UL + | OptionalAttribute = 0x800000UL + | StructAttribute = 0x1000000UL + | NotComputed = 0x8000000000000000UL + type Attribs = Attrib list [] From 27e74246b56bb0fbae35d89649177dc126e54081 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 20 Feb 2026 20:47:35 +0100 Subject: [PATCH 02/71] Add computeILWellKnownFlags and migrate IL attribute check sites - Add computeILWellKnownFlags function in TypedTreeOps.fs that maps all 19 WellKnownILAttributes enum values to their TcGlobals attrib_* fields - Add HasWellKnownAttribute extension members on ILAttributesStored, ILTypeDef, ILMethodDef, and ILFieldDef - Migrate 12 IL-domain existence-only check sites from O(N) TryFindILAttribute scans to O(1) HasWellKnownAttribute calls - Fix pre-existing ILAttributesStored sealed class callers (Given -> CreateGiven, customAttrsReader -> CreateReader pattern in ilread.fs) - Keep 3 data-extracting sites (ReflectedDefinition, AutoOpen, InternalsVisibleTo) and 2 individual-attribute iteration sites unchanged - TypeHierarchy.fs sites use TryFindILAttribute on storedAttrs.CustomAttrs (scope comparison prevents full HasWellKnownAttribute migration) Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/AbstractIL/il.fs | 101 ++++++++++-------- src/Compiler/AbstractIL/il.fsi | 18 ++-- src/Compiler/AbstractIL/ilread.fs | 82 +++++++------- .../Checking/Expressions/CheckExpressions.fs | 7 +- src/Compiler/Checking/TypeHierarchy.fs | 6 +- src/Compiler/Checking/import.fs | 4 +- src/Compiler/Checking/infos.fs | 21 ++-- src/Compiler/CodeGen/EraseUnions.fs | 4 +- src/Compiler/CodeGen/IlxGen.fs | 6 +- src/Compiler/TypedTree/TypedTreeOps.fs | 94 +++++++++++++++- src/Compiler/TypedTree/TypedTreeOps.fsi | 19 ++++ 11 files changed, 252 insertions(+), 110 deletions(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index 77605454840..bd58f1dbc1d 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -1253,19 +1253,47 @@ type WellKnownILAttributes = | DefaultMemberAttribute = 0x40000u | NotComputed = 0x80000000u -[] -type ILAttributesStored = - - /// Computed by ilread.fs based on metadata index +type internal ILAttributesStoredRepr = | Reader of (int32 -> ILAttribute[]) - - /// Already computed | Given of ILAttributes + | Computed of ILAttributes * WellKnownILAttributes - member x.GetCustomAttrs metadataIndex = - match x with - | Reader f -> ILAttributes(f metadataIndex) - | Given attrs -> attrs +[] +type ILAttributesStored private (metadataIndex: int32, initial: ILAttributesStoredRepr) = + let mutable repr = initial + + member _.MetadataIndex = metadataIndex + + member x.CustomAttrs: ILAttributes = + match repr with + | Computed(a, _) + | Given a -> a + | Reader f -> + let r = ILAttributes(f metadataIndex) + repr <- Given r + r + + /// Backward compat — old callers that still pass metadataIndex. + member x.GetCustomAttrs(_metadataIndex: int32) : ILAttributes = x.CustomAttrs + + member x.HasWellKnownAttribute(flag: WellKnownILAttributes, compute: ILAttributes -> WellKnownILAttributes) : bool = + x.GetOrComputeWellKnownFlags(compute) &&& flag <> WellKnownILAttributes.None + + member x.GetOrComputeWellKnownFlags(compute: ILAttributes -> WellKnownILAttributes) : WellKnownILAttributes = + match repr with + | Computed(_, flags) -> flags + | _ -> + let a = x.CustomAttrs + let f = compute a + repr <- Computed(a, f) + f + + static member CreateReader(idx: int32, f: int32 -> ILAttribute[]) = + ILAttributesStored(idx, Reader f) + + static member CreateGiven(attrs: ILAttributes) = ILAttributesStored(-1, Given attrs) + + static member CreateGiven(idx: int32, attrs: ILAttributes) = ILAttributesStored(idx, Given attrs) let emptyILCustomAttrs = ILAttributes [||] @@ -1280,18 +1308,21 @@ let mkILCustomAttrs l = | [] -> emptyILCustomAttrs | _ -> mkILCustomAttrsFromArray (List.toArray l) -let emptyILCustomAttrsStored = ILAttributesStored.Given emptyILCustomAttrs +let emptyILCustomAttrsStored = ILAttributesStored.CreateGiven emptyILCustomAttrs let storeILCustomAttrs (attrs: ILAttributes) = if attrs.AsArray().Length = 0 then emptyILCustomAttrsStored else - ILAttributesStored.Given attrs + ILAttributesStored.CreateGiven attrs let mkILCustomAttrsComputed f = - ILAttributesStored.Reader(fun _ -> f ()) + ILAttributesStored.CreateReader(-1, fun _ -> f ()) + +let mkILCustomAttrsReader f = ILAttributesStored.CreateReader(-1, f) -let mkILCustomAttrsReader f = ILAttributesStored.Reader f +let mkILCustomAttrsReaderWithIndex idx f = + ILAttributesStored.CreateReader(idx, f) type ILCodeLabel = int @@ -1815,7 +1846,7 @@ type ILParameter = MetadataIndex: int32 } - member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex + member x.CustomAttrs = x.CustomAttrsStored.CustomAttrs override x.ToString() = x.Name |> Option.defaultValue "" @@ -1833,7 +1864,7 @@ type ILReturn = override x.ToString() = "" - member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex + member x.CustomAttrs = x.CustomAttrsStored.CustomAttrs member x.WithCustomAttrs(customAttrs) = { x with @@ -1894,7 +1925,7 @@ type ILGenericParameterDef = MetadataIndex: int32 } - member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex + member x.CustomAttrs = x.CustomAttrsStored.CustomAttrs /// For debugging [] @@ -1940,13 +1971,7 @@ type InterfaceImpl = mutable CustomAttrsStored: ILAttributesStored } - member x.CustomAttrs = - match x.CustomAttrsStored with - | ILAttributesStored.Reader f -> - let res = ILAttributes(f x.Idx) - x.CustomAttrsStored <- ILAttributesStored.Given res - res - | ILAttributesStored.Given attrs -> attrs + member x.CustomAttrs = x.CustomAttrsStored.CustomAttrs static member Create(ilType: ILType, customAttrsStored: ILAttributesStored) = { @@ -2053,7 +2078,7 @@ type ILMethodDef | Some attrs -> attrs) ) - member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs metadataIndex + member x.CustomAttrs = x.CustomAttrsStored.CustomAttrs member x.SecurityDecls = x.SecurityDeclsStored.GetSecurityDecls x.MetadataIndex @@ -2290,7 +2315,7 @@ type ILEventDef member _.MetadataIndex = metadataIndex - member x.CustomAttrs = customAttrsStored.GetCustomAttrs x.MetadataIndex + member x.CustomAttrs = customAttrsStored.CustomAttrs member x.With(?eventType, ?name, ?attributes, ?addMethod, ?removeMethod, ?fireMethod, ?otherMethods, ?customAttrs) = ILEventDef( @@ -2366,7 +2391,7 @@ type ILPropertyDef member x.Init = init member x.Args = args member x.CustomAttrsStored = customAttrsStored - member x.CustomAttrs = customAttrsStored.GetCustomAttrs x.MetadataIndex + member x.CustomAttrs = customAttrsStored.CustomAttrs member x.MetadataIndex = metadataIndex member x.With(?name, ?attributes, ?setMethod, ?getMethod, ?callingConv, ?propertyType, ?init, ?args, ?customAttrs) = @@ -2442,7 +2467,7 @@ type ILFieldDef member _.Offset = offset member _.Marshal = marshal member x.CustomAttrsStored = customAttrsStored - member x.CustomAttrs = customAttrsStored.GetCustomAttrs x.MetadataIndex + member x.CustomAttrs = customAttrsStored.CustomAttrs member x.MetadataIndex = metadataIndex member x.With @@ -2701,8 +2726,6 @@ type ILTypeDef metadataIndex: int32 ) = - let mutable customAttrsStored = customAttrsStored - let hasFlag flag = additionalFlags &&& flag = flag new @@ -2853,13 +2876,7 @@ type ILTypeDef customAttrs = defaultArg customAttrs x.CustomAttrsStored ) - member x.CustomAttrs: ILAttributes = - match customAttrsStored with - | ILAttributesStored.Reader f -> - let res = ILAttributes(f x.MetadataIndex) - customAttrsStored <- ILAttributesStored.Given res - res - | ILAttributesStored.Given res -> res + member x.CustomAttrs: ILAttributes = customAttrsStored.CustomAttrs member x.SecurityDecls = x.SecurityDeclsStored.GetSecurityDecls x.MetadataIndex @@ -3017,7 +3034,7 @@ type ILNestedExportedType = MetadataIndex: int32 } - member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex + member x.CustomAttrs = x.CustomAttrsStored.CustomAttrs override x.ToString() = "exported type " + x.Name @@ -3041,7 +3058,7 @@ and [] ILExportedTypeOrForwarder = member x.IsForwarder = x.Attributes &&& enum 0x00200000 <> enum 0 - member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex + member x.CustomAttrs = x.CustomAttrsStored.CustomAttrs override x.ToString() = "exported type " + x.Name @@ -3081,7 +3098,7 @@ type ILResource = | ILResourceLocation.Local bytes -> bytes.GetByteMemory() | _ -> failwith "GetBytes" - member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex + member x.CustomAttrs = x.CustomAttrsStored.CustomAttrs override x.ToString() = "resource " + x.Name @@ -3128,7 +3145,7 @@ type ILAssemblyManifest = MetadataIndex: int32 } - member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex + member x.CustomAttrs = x.CustomAttrsStored.CustomAttrs member x.SecurityDecls = x.SecurityDeclsStored.GetSecurityDecls x.MetadataIndex @@ -3175,7 +3192,7 @@ type ILModuleDef = | None -> false | _ -> true - member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex + member x.CustomAttrs = x.CustomAttrsStored.CustomAttrs override x.ToString() = "assembly " + x.Name diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index ec78eb04a5a..eff249f5b01 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -903,14 +903,19 @@ type WellKnownILAttributes = | NotComputed = 0x80000000u /// Represents the efficiency-oriented storage of ILAttributes in another item. -[] +[] type ILAttributesStored = - /// Computed by ilread.fs based on metadata index - | Reader of (int32 -> ILAttribute[]) - /// Already computed - | Given of ILAttributes - + member CustomAttrs: ILAttributes member GetCustomAttrs: int32 -> ILAttributes + member MetadataIndex: int32 + + member HasWellKnownAttribute: + flag: WellKnownILAttributes * compute: (ILAttributes -> WellKnownILAttributes) -> bool + + member GetOrComputeWellKnownFlags: compute: (ILAttributes -> WellKnownILAttributes) -> WellKnownILAttributes + static member CreateReader: idx: int32 * f: (int32 -> ILAttribute[]) -> ILAttributesStored + static member CreateGiven: attrs: ILAttributes -> ILAttributesStored + static member CreateGiven: idx: int32 * attrs: ILAttributes -> ILAttributesStored /// Method parameters and return values. [] @@ -2307,6 +2312,7 @@ val mkILCustomAttrsFromArray: ILAttribute[] -> ILAttributes val storeILCustomAttrs: ILAttributes -> ILAttributesStored val mkILCustomAttrsComputed: (unit -> ILAttribute[]) -> ILAttributesStored val internal mkILCustomAttrsReader: (int32 -> ILAttribute[]) -> ILAttributesStored +val internal mkILCustomAttrsReaderWithIndex: int32 -> (int32 -> ILAttribute[]) -> ILAttributesStored val emptyILCustomAttrs: ILAttributes val emptyILCustomAttrsStored: ILAttributesStored diff --git a/src/Compiler/AbstractIL/ilread.fs b/src/Compiler/AbstractIL/ilread.fs index 0a48f7c5a4f..7754fedad20 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -1150,18 +1150,18 @@ type ILMetadataReader = seekReadMethodDefAsMethodData: int -> MethodData seekReadGenericParams: GenericParamsIdx -> ILGenericParameterDef list seekReadFieldDefAsFieldSpec: int -> ILFieldSpec - customAttrsReader_Module: ILAttributesStored - customAttrsReader_Assembly: ILAttributesStored - customAttrsReader_TypeDef: ILAttributesStored - customAttrsReader_InterfaceImpl: ILAttributesStored - customAttrsReader_GenericParam: ILAttributesStored - customAttrsReader_FieldDef: ILAttributesStored - customAttrsReader_MethodDef: ILAttributesStored - customAttrsReader_ParamDef: ILAttributesStored - customAttrsReader_Event: ILAttributesStored - customAttrsReader_Property: ILAttributesStored - customAttrsReader_ManifestResource: ILAttributesStored - customAttrsReader_ExportedType: ILAttributesStored + customAttrsReaderFn_Module: int32 -> ILAttribute[] + customAttrsReaderFn_Assembly: int32 -> ILAttribute[] + customAttrsReaderFn_TypeDef: int32 -> ILAttribute[] + customAttrsReaderFn_InterfaceImpl: int32 -> ILAttribute[] + customAttrsReaderFn_GenericParam: int32 -> ILAttribute[] + customAttrsReaderFn_FieldDef: int32 -> ILAttribute[] + customAttrsReaderFn_MethodDef: int32 -> ILAttribute[] + customAttrsReaderFn_ParamDef: int32 -> ILAttribute[] + customAttrsReaderFn_Event: int32 -> ILAttribute[] + customAttrsReaderFn_Property: int32 -> ILAttribute[] + customAttrsReaderFn_ManifestResource: int32 -> ILAttribute[] + customAttrsReaderFn_ExportedType: int32 -> ILAttribute[] securityDeclsReader_TypeDef: ILSecurityDeclsStored securityDeclsReader_MethodDef: ILSecurityDeclsStored securityDeclsReader_Assembly: ILSecurityDeclsStored @@ -1884,7 +1884,7 @@ let rec seekReadModule (ctxt: ILMetadataReader) canReduceMemory (pectxtEager: PE Some(seekReadAssemblyManifest ctxt pectxtEager 1) else None - CustomAttrsStored = ctxt.customAttrsReader_Module + CustomAttrsStored = ILAttributesStored.CreateReader(idx, ctxt.customAttrsReaderFn_Module) MetadataIndex = idx Name = ilModuleName NativeResources = nativeResources @@ -1927,7 +1927,7 @@ and seekReadAssemblyManifest (ctxt: ILMetadataReader) pectxt idx = | _ -> None Version = Some(ILVersionInfo(v1, v2, v3, v4)) Locale = readStringHeapOption ctxt localeIdx - CustomAttrsStored = ctxt.customAttrsReader_Assembly + CustomAttrsStored = ILAttributesStored.CreateReader(idx, ctxt.customAttrsReaderFn_Assembly) MetadataIndex = idx AssemblyLongevity = let masked = flags &&& 0x000e @@ -2229,7 +2229,7 @@ and typeDefReader ctxtH : ILTypeDefStored = events = events, properties = props, additionalFlags = additionalFlags, - customAttrsStored = ctxt.customAttrsReader_TypeDef, + customAttrsStored = ILAttributesStored.CreateReader(idx, ctxt.customAttrsReaderFn_TypeDef), metadataIndex = idx )) @@ -2271,7 +2271,7 @@ and seekReadInterfaceImpls (ctxt: ILMetadataReader) mdv numTypars tidx = { Idx = idx Type = ilType - CustomAttrsStored = ctxt.customAttrsReader_InterfaceImpl + CustomAttrsStored = ILAttributesStored.CreateReader(idx, ctxt.customAttrsReaderFn_InterfaceImpl) }) )) @@ -2308,7 +2308,7 @@ and seekReadGenericParamsUncached ctxtH (GenericParamsIdx(numTypars, a, b)) = Name = readStringHeap ctxt nameIdx Constraints = constraints Variance = variance - CustomAttrsStored = ctxt.customAttrsReader_GenericParam + CustomAttrsStored = ILAttributesStored.CreateReader(gpidx, ctxt.customAttrsReaderFn_GenericParam) MetadataIndex = gpidx HasReferenceTypeConstraint = (flags &&& 0x0004) <> 0 HasNotNullableValueTypeConstraint = (flags &&& 0x0008) <> 0 @@ -2546,7 +2546,7 @@ and seekReadField ctxt mdv (numTypars, hasLayout) (idx: int) = ) else None), - customAttrsStored = ctxt.customAttrsReader_FieldDef, + customAttrsStored = ILAttributesStored.CreateReader(idx, ctxt.customAttrsReaderFn_FieldDef), metadataIndex = idx ) @@ -3054,7 +3054,7 @@ and seekReadMethod (ctxt: ILMetadataReader) mdv numTypars (idx: int) = callingConv = cc, ret = ret, body = body, - customAttrsStored = ctxt.customAttrsReader_MethodDef, + customAttrsStored = ILAttributesStored.CreateReader(idx, ctxt.customAttrsReaderFn_MethodDef), metadataIndex = idx ) @@ -3091,7 +3091,7 @@ and seekReadParamExtras (ctxt: ILMetadataReader) mdv (retRes: byref, p Some(fmReader (TaggedIndex(hfm_ParamDef, idx))) else None) - CustomAttrsStored = ctxt.customAttrsReader_ParamDef + CustomAttrsStored = ILAttributesStored.CreateReader(idx, ctxt.customAttrsReaderFn_ParamDef) MetadataIndex = idx } elif seq > Array.length paramsRes then @@ -3113,7 +3113,7 @@ and seekReadParamExtras (ctxt: ILMetadataReader) mdv (retRes: byref, p IsIn = ((inOutMasked &&& 0x0001) <> 0x0) IsOut = ((inOutMasked &&& 0x0002) <> 0x0) IsOptional = ((inOutMasked &&& 0x0010) <> 0x0) - CustomAttrsStored = ctxt.customAttrsReader_ParamDef + CustomAttrsStored = ILAttributesStored.CreateReader(idx, ctxt.customAttrsReaderFn_ParamDef) MetadataIndex = idx } @@ -3192,7 +3192,7 @@ and seekReadEvent ctxt mdv numTypars idx = removeMethod = seekReadMethodSemantics ctxt (0x0010, TaggedIndex(hs_Event, idx)), fireMethod = seekReadOptionalMethodSemantics ctxt (0x0020, TaggedIndex(hs_Event, idx)), otherMethods = seekReadMultipleMethodSemantics ctxt (0x0004, TaggedIndex(hs_Event, idx)), - customAttrsStored = ctxt.customAttrsReader_Event, + customAttrsStored = ILAttributesStored.CreateReader(idx, ctxt.customAttrsReaderFn_Event), metadataIndex = idx ) @@ -3263,7 +3263,7 @@ and seekReadProperty ctxt mdv numTypars idx = else Some(seekReadConstant ctxt (TaggedIndex(hc_Property, idx)))), args = argTys, - customAttrsStored = ctxt.customAttrsReader_Property, + customAttrsStored = ILAttributesStored.CreateReader(idx, ctxt.customAttrsReaderFn_Property), metadataIndex = idx ) @@ -3301,8 +3301,8 @@ and seekReadProperties (ctxt: ILMetadataReader) numTypars tidx = ]) ) -and customAttrsReader ctxtH tag : ILAttributesStored = - mkILCustomAttrsReader (fun idx -> +and customAttrsReaderFn ctxtH tag : int32 -> ILAttribute[] = + fun idx -> let (ctxt: ILMetadataReader) = getHole ctxtH let mdv = ctxt.mdfile.GetView() @@ -3325,7 +3325,7 @@ and customAttrsReader ctxtH tag : ILAttributesStored = seekReadCustomAttr ctxt (attrRow.typeIndex, attrRow.valueIndex) } - seekReadIndexedRowsByInterface (ctxt.getNumRows TableNames.CustomAttribute) (isSorted ctxt TableNames.CustomAttribute) reader) + seekReadIndexedRowsByInterface (ctxt.getNumRows TableNames.CustomAttribute) (isSorted ctxt TableNames.CustomAttribute) reader and seekReadCustomAttr ctxt (TaggedIndex(cat, idx), b) = ctxt.seekReadCustomAttr (CustomAttrIdx(cat, idx, b)) @@ -4111,7 +4111,7 @@ and seekReadManifestResources (ctxt: ILMetadataReader) canReduceMemory (mdv: Bin ILResourceAccess.Public else ILResourceAccess.Private) - CustomAttrsStored = ctxt.customAttrsReader_ManifestResource + CustomAttrsStored = ILAttributesStored.CreateReader(i, ctxt.customAttrsReaderFn_ManifestResource) MetadataIndex = i } @@ -4132,7 +4132,7 @@ and seekReadNestedExportedTypes ctxt (exported: _[]) (nested: Lazy<_[]>) parentI | ILTypeDefAccess.Nested n -> n | _ -> failwith "non-nested access for a nested type described as being in an auxiliary module") Nested = seekReadNestedExportedTypes ctxt exported nested i - CustomAttrsStored = ctxt.customAttrsReader_ExportedType + CustomAttrsStored = ILAttributesStored.CreateReader(i, ctxt.customAttrsReaderFn_ExportedType) MetadataIndex = i }) ) @@ -4171,7 +4171,7 @@ and seekReadTopExportedTypes (ctxt: ILMetadataReader) = Name = readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) Attributes = enum flags Nested = seekReadNestedExportedTypes ctxt exported nested i - CustomAttrsStored = ctxt.customAttrsReader_ExportedType + CustomAttrsStored = ILAttributesStored.CreateReader(i, ctxt.customAttrsReaderFn_ExportedType) MetadataIndex = i } ] @@ -4591,18 +4591,18 @@ let openMetadataReader seekReadMethodDefAsMethodData = cacheMethodDefAsMethodData (seekReadMethodDefAsMethodDataUncached ctxtH) seekReadGenericParams = cacheGenericParams (seekReadGenericParamsUncached ctxtH) seekReadFieldDefAsFieldSpec = cacheFieldDefAsFieldSpec (seekReadFieldDefAsFieldSpecUncached ctxtH) - customAttrsReader_Module = customAttrsReader ctxtH hca_Module - customAttrsReader_Assembly = customAttrsReader ctxtH hca_Assembly - customAttrsReader_TypeDef = customAttrsReader ctxtH hca_TypeDef - customAttrsReader_InterfaceImpl = customAttrsReader ctxtH hca_InterfaceImpl - customAttrsReader_GenericParam = customAttrsReader ctxtH hca_GenericParam - customAttrsReader_FieldDef = customAttrsReader ctxtH hca_FieldDef - customAttrsReader_MethodDef = customAttrsReader ctxtH hca_MethodDef - customAttrsReader_ParamDef = customAttrsReader ctxtH hca_ParamDef - customAttrsReader_Event = customAttrsReader ctxtH hca_Event - customAttrsReader_Property = customAttrsReader ctxtH hca_Property - customAttrsReader_ManifestResource = customAttrsReader ctxtH hca_ManifestResource - customAttrsReader_ExportedType = customAttrsReader ctxtH hca_ExportedType + customAttrsReaderFn_Module = customAttrsReaderFn ctxtH hca_Module + customAttrsReaderFn_Assembly = customAttrsReaderFn ctxtH hca_Assembly + customAttrsReaderFn_TypeDef = customAttrsReaderFn ctxtH hca_TypeDef + customAttrsReaderFn_InterfaceImpl = customAttrsReaderFn ctxtH hca_InterfaceImpl + customAttrsReaderFn_GenericParam = customAttrsReaderFn ctxtH hca_GenericParam + customAttrsReaderFn_FieldDef = customAttrsReaderFn ctxtH hca_FieldDef + customAttrsReaderFn_MethodDef = customAttrsReaderFn ctxtH hca_MethodDef + customAttrsReaderFn_ParamDef = customAttrsReaderFn ctxtH hca_ParamDef + customAttrsReaderFn_Event = customAttrsReaderFn ctxtH hca_Event + customAttrsReaderFn_Property = customAttrsReaderFn ctxtH hca_Property + customAttrsReaderFn_ManifestResource = customAttrsReaderFn ctxtH hca_ManifestResource + customAttrsReaderFn_ExportedType = customAttrsReaderFn ctxtH hca_ExportedType securityDeclsReader_TypeDef = securityDeclsReader ctxtH hds_TypeDef securityDeclsReader_MethodDef = securityDeclsReader ctxtH hds_MethodDef securityDeclsReader_Assembly = securityDeclsReader ctxtH hds_Assembly diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index be76ee77ac5..6f129bdc828 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -1325,7 +1325,12 @@ let CheckRequiredProperties (g:TcGlobals) (env: TcEnv) (cenv: TcFileState) (minf // 3. If some are missing, produce a diagnostic which missing ones. if g.langVersion.SupportsFeature(LanguageFeature.RequiredPropertiesSupport) && minfo.IsConstructor - && not (TryFindILAttribute g.attrib_SetsRequiredMembersAttribute (minfo.GetCustomAttrs())) then + && not ( + match minfo with + | ILMeth(_, ilMethInfo, _) -> + ilMethInfo.RawMetadata.HasWellKnownAttribute(g, WellKnownILAttributes.SetsRequiredMembersAttribute) + | _ -> TryFindILAttribute g.attrib_SetsRequiredMembersAttribute (minfo.GetCustomAttrs()) + ) then let requiredProps = [ diff --git a/src/Compiler/Checking/TypeHierarchy.fs b/src/Compiler/Checking/TypeHierarchy.fs index 266e44214b2..9b35a7f9497 100644 --- a/src/Compiler/Checking/TypeHierarchy.fs +++ b/src/Compiler/Checking/TypeHierarchy.fs @@ -374,9 +374,11 @@ let ImportILTypeFromMetadataWithAttributes amap m scoref tinst minst nullnessSou // - a `IsReadOnlyAttribute` - it's an inref // - a `RequiresLocationAttribute` (in which case it's a `ref readonly`) which we treat as inref, // latter is an ad-hoc fix for https://github.com/dotnet/runtime/issues/94317. + let (AttributesFromIL(_, storedAttrs)) = nullnessSource.DirectAttributes + if isByrefTy amap.g ty - && (TryFindILAttribute amap.g.attrib_IsReadOnlyAttribute (nullnessSource.DirectAttributes.Read()) - || TryFindILAttribute amap.g.attrib_RequiresLocationAttribute (nullnessSource.DirectAttributes.Read())) then + && (TryFindILAttribute amap.g.attrib_IsReadOnlyAttribute storedAttrs.CustomAttrs + || TryFindILAttribute amap.g.attrib_RequiresLocationAttribute storedAttrs.CustomAttrs) then mkInByrefTy amap.g (destByrefTy amap.g ty) else ty diff --git a/src/Compiler/Checking/import.fs b/src/Compiler/Checking/import.fs index 644d7c2e8a5..7a1efe641ba 100644 --- a/src/Compiler/Checking/import.fs +++ b/src/Compiler/Checking/import.fs @@ -244,7 +244,7 @@ module Nullness = |> ValueOption.orElseWith (fun () -> classCtx.GetNullableContext(g))) |> ValueOption.defaultValue arrayWithByte0 static member Empty = - let emptyFromIL = AttributesFromIL(0,Given(ILAttributes.Empty)) + let emptyFromIL = AttributesFromIL(0,ILAttributesStored.CreateGiven(ILAttributes.Empty)) {DirectAttributes = emptyFromIL; Fallback = FromClass(emptyFromIL)} [] @@ -648,7 +648,7 @@ let ImportILGenericParameters amap m scoref tinst (nullableFallback:Nullness.Nul //| [|2uy|] -> TyparConstraint.SupportsNull(m) | _ -> () - if gp.CustomAttrs |> TryFindILAttribute amap.g.attrib_IsUnmanagedAttribute then + if gp.CustomAttrsStored.HasWellKnownAttribute(amap.g, WellKnownILAttributes.IsUnmanagedAttribute) then TyparConstraint.IsUnmanaged(m) if gp.HasDefaultConstructorConstraint then TyparConstraint.RequiresDefaultConstructor(m) diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index edfc560aa81..d00087cfc5d 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -208,9 +208,8 @@ type OptionalArgInfo = match ilParam.Marshal with | Some(ILNativeType.IUnknown | ILNativeType.IDispatch | ILNativeType.Interface) -> Constant ILFieldInit.Null | _ -> - let attrs = ilParam.CustomAttrs - if TryFindILAttributeOpt g.attrib_IUnknownConstantAttribute attrs then WrapperForIUnknown - elif TryFindILAttributeOpt g.attrib_IDispatchConstantAttribute attrs then WrapperForIDispatch + if ilParam.CustomAttrsStored.HasWellKnownAttribute(g, WellKnownILAttributes.IUnknownConstantAttribute) then WrapperForIUnknown + elif ilParam.CustomAttrsStored.HasWellKnownAttribute(g, WellKnownILAttributes.IDispatchConstantAttribute) then WrapperForIDispatch else MissingValue else DefaultValue @@ -441,8 +440,7 @@ type ILTypeInfo = /// Indicates if the type is marked with the [] attribute. member x.IsReadOnly (g: TcGlobals) = - x.RawMetadata.CustomAttrs - |> TryFindILAttribute g.attrib_IsReadOnlyAttribute + x.RawMetadata.HasWellKnownAttribute(g, WellKnownILAttributes.IsReadOnlyAttribute) member x.Instantiate inst = let (ILTypeInfo(g, ty, tref, tdef)) = x @@ -585,7 +583,7 @@ type ILMethInfo = match x with | ILMethInfo(ilType=CSharpStyleExtension(declaring= t)) when t.IsILTycon -> AttributesFromIL(t.ILTyconRawMetadata.MetadataIndex,t.ILTyconRawMetadata.CustomAttrsStored) // C#-style extension defined in F# -> we do not support manually adding NullableContextAttribute by F# users. - | ILMethInfo(ilType=CSharpStyleExtension _) -> AttributesFromIL(0,Given(ILAttributes.Empty)) + | ILMethInfo(ilType=CSharpStyleExtension _) -> AttributesFromIL(0,ILAttributesStored.CreateGiven(ILAttributes.Empty)) | ILMethInfo(ilType=IlType(t)) -> t.NullableAttributes FromMethodAndClass(AttributesFromIL(raw.MetadataIndex,raw.CustomAttrsStored),classAttrs) @@ -628,8 +626,7 @@ type ILMethInfo = /// Indicates if the method is marked with the [] attribute. This is done by looking at the IL custom attributes on /// the method. member x.IsReadOnly (g: TcGlobals) = - x.RawMetadata.CustomAttrs - |> TryFindILAttribute g.attrib_IsReadOnlyAttribute + x.RawMetadata.HasWellKnownAttribute(g, WellKnownILAttributes.IsReadOnlyAttribute) /// Get the (zero or one) 'self'/'this'/'object' arguments associated with an IL method. /// An instance extension method returns one object argument. @@ -1263,7 +1260,7 @@ type MethInfo = | ILMeth(g, ilMethInfo, _) -> [ [ for p in ilMethInfo.ParamMetadata do let attrs = p.CustomAttrs - let isParamArrayArg = TryFindILAttribute g.attrib_ParamArrayAttribute attrs + let isParamArrayArg = p.CustomAttrsStored.HasWellKnownAttribute(g, WellKnownILAttributes.ParamArrayAttribute) let reflArgInfo = match TryDecodeILAttribute g.attrib_ReflectedDefinitionAttribute.TypeRef attrs with | Some ([ILAttribElem.Bool b ], _) -> ReflectedArgInfo.Quote b @@ -1274,9 +1271,9 @@ type MethInfo = // Note: we get default argument values from VB and other .NET language metadata let optArgInfo = OptionalArgInfo.FromILParameter g amap m ilMethInfo.MetadataScope ilMethInfo.DeclaringTypeInst p - let isCallerLineNumberArg = TryFindILAttribute g.attrib_CallerLineNumberAttribute attrs - let isCallerFilePathArg = TryFindILAttribute g.attrib_CallerFilePathAttribute attrs - let isCallerMemberNameArg = TryFindILAttribute g.attrib_CallerMemberNameAttribute attrs + let isCallerLineNumberArg = p.CustomAttrsStored.HasWellKnownAttribute(g, WellKnownILAttributes.CallerLineNumberAttribute) + let isCallerFilePathArg = p.CustomAttrsStored.HasWellKnownAttribute(g, WellKnownILAttributes.CallerFilePathAttribute) + let isCallerMemberNameArg = p.CustomAttrsStored.HasWellKnownAttribute(g, WellKnownILAttributes.CallerMemberNameAttribute) let callerInfo = match isCallerLineNumberArg, isCallerFilePathArg, isCallerMemberNameArg with diff --git a/src/Compiler/CodeGen/EraseUnions.fs b/src/Compiler/CodeGen/EraseUnions.fs index 3e24a332d33..ef47028b256 100644 --- a/src/Compiler/CodeGen/EraseUnions.fs +++ b/src/Compiler/CodeGen/EraseUnions.fs @@ -893,7 +893,9 @@ let convAlternativeDef alt.FieldDefs // Fields that are nullable even from F# perspective has an [Nullable] attribute on them // Non-nullable fields are implicit in F#, therefore not annotated separately - |> Array.filter (fun f -> TryFindILAttribute g.attrib_NullableAttribute f.ILField.CustomAttrs |> not) + |> Array.filter (fun f -> + f.ILField.HasWellKnownAttribute(g, WellKnownILAttributes.NullableAttribute) + |> not) let fieldNames = notnullfields diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 1e2f26b011e..9231fa10c26 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -1935,7 +1935,7 @@ type TypeDefBuilder(tdef: ILTypeDef, tdefDiscards) = [| yield! attrsBefore.AsArray() - if attrsBefore |> TryFindILAttribute g.attrib_AllowNullLiteralAttribute then + if tdef.HasWellKnownAttribute(g, WellKnownILAttributes.AllowNullLiteralAttribute) then yield GetNullableAttribute g [ NullnessInfo.WithNull ] if (gmethods.Count + gfields.Count + gproperties.Count) > 0 then yield GetNullableContextAttribute g 1uy @@ -10881,7 +10881,9 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option let customAttrs = if checkNullness then - GenAdditionalAttributesForTy g x |> mkILCustomAttrs |> ILAttributesStored.Given + GenAdditionalAttributesForTy g x + |> mkILCustomAttrs + |> ILAttributesStored.CreateGiven else emptyILCustomAttrsStored diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 9ddb334b97d..c99b8833475 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3614,7 +3614,99 @@ let TryFindILAttributeOpt attr attrs = | _ -> false let IsILAttrib (AttribInfo (builtInAttrRef, _)) attr = isILAttrib builtInAttrRef attr - + +/// Compute well-known attribute flags for an ILAttributes collection. +/// This is the 'compute' callback passed to ILAttributesStored.HasWellKnownAttribute. +let computeILWellKnownFlags (g: TcGlobals) (attrs: ILAttributes) : WellKnownILAttributes = + let mutable flags = WellKnownILAttributes.None + + let (AttribInfo(isReadOnlyRef, _)) = g.attrib_IsReadOnlyAttribute + let (AttribInfo(isUnmanagedRef, _)) = g.attrib_IsUnmanagedAttribute + let (AttribInfo(extensionRef, _)) = g.attrib_ExtensionAttribute + let (AttribInfo(paramArrayRef, _)) = g.attrib_ParamArrayAttribute + let (AttribInfo(allowNullLiteralRef, _)) = g.attrib_AllowNullLiteralAttribute + let (AttribInfo(reflectedDefRef, _)) = g.attrib_ReflectedDefinitionAttribute + let (AttribInfo(autoOpenRef, _)) = g.attrib_AutoOpenAttribute + let (AttribInfo(internalsVisibleToRef, _)) = g.attrib_InternalsVisibleToAttribute + let (AttribInfo(callerMemberNameRef, _)) = g.attrib_CallerMemberNameAttribute + let (AttribInfo(callerFilePathRef, _)) = g.attrib_CallerFilePathAttribute + let (AttribInfo(callerLineNumberRef, _)) = g.attrib_CallerLineNumberAttribute + let (AttribInfo(defaultMemberRef, _)) = g.attrib_DefaultMemberAttribute + let (AttribInfo(setsRequiredMembersRef, _)) = g.attrib_SetsRequiredMembersAttribute + let (AttribInfo(requiresLocationRef, _)) = g.attrib_RequiresLocationAttribute + let (AttribInfo(nullableRef, _)) = g.attrib_NullableAttribute + let (AttribInfo(noEagerConstraintRef, _)) = g.attrib_NoEagerConstraintApplicationAttribute + + for attr in attrs.AsArray() do + let atref = attr.Method.DeclaringType.TypeSpec.TypeRef + + if atref = isReadOnlyRef then + flags <- flags ||| WellKnownILAttributes.IsReadOnlyAttribute + elif atref = isUnmanagedRef then + flags <- flags ||| WellKnownILAttributes.IsUnmanagedAttribute + elif atref = extensionRef then + flags <- flags ||| WellKnownILAttributes.ExtensionAttribute + elif atref = paramArrayRef then + flags <- flags ||| WellKnownILAttributes.ParamArrayAttribute + elif atref = allowNullLiteralRef then + flags <- flags ||| WellKnownILAttributes.AllowNullLiteralAttribute + elif atref = reflectedDefRef then + flags <- flags ||| WellKnownILAttributes.ReflectedDefinitionAttribute + elif atref = autoOpenRef then + flags <- flags ||| WellKnownILAttributes.AutoOpenAttribute + elif atref = internalsVisibleToRef then + flags <- flags ||| WellKnownILAttributes.InternalsVisibleToAttribute + elif atref = callerMemberNameRef then + flags <- flags ||| WellKnownILAttributes.CallerMemberNameAttribute + elif atref = callerFilePathRef then + flags <- flags ||| WellKnownILAttributes.CallerFilePathAttribute + elif atref = callerLineNumberRef then + flags <- flags ||| WellKnownILAttributes.CallerLineNumberAttribute + elif atref = defaultMemberRef then + flags <- flags ||| WellKnownILAttributes.DefaultMemberAttribute + elif atref = setsRequiredMembersRef then + flags <- flags ||| WellKnownILAttributes.SetsRequiredMembersAttribute + elif atref = requiresLocationRef then + flags <- flags ||| WellKnownILAttributes.RequiresLocationAttribute + elif atref = nullableRef then + flags <- flags ||| WellKnownILAttributes.NullableAttribute + elif atref = noEagerConstraintRef then + flags <- flags ||| WellKnownILAttributes.NoEagerConstraintApplicationAttribute + else + match g.attrib_IsByRefLikeAttribute_opt with + | Some(AttribInfo(r, _)) when atref = r -> + flags <- flags ||| WellKnownILAttributes.IsByRefLikeAttribute + | _ -> + match g.attrib_IDispatchConstantAttribute with + | Some(AttribInfo(r, _)) when atref = r -> + flags <- flags ||| WellKnownILAttributes.IDispatchConstantAttribute + | _ -> + match g.attrib_IUnknownConstantAttribute with + | Some(AttribInfo(r, _)) when atref = r -> + flags <- flags ||| WellKnownILAttributes.IUnknownConstantAttribute + | _ -> () + + flags + +type ILAttributesStored with + + member x.HasWellKnownAttribute(g: TcGlobals, flag: WellKnownILAttributes) = + x.HasWellKnownAttribute(flag, computeILWellKnownFlags g) + +type ILTypeDef with + + member x.HasWellKnownAttribute(g: TcGlobals, flag: WellKnownILAttributes) = + x.CustomAttrsStored.HasWellKnownAttribute(g, flag) + +type ILMethodDef with + + member x.HasWellKnownAttribute(g: TcGlobals, flag: WellKnownILAttributes) = + x.CustomAttrsStored.HasWellKnownAttribute(g, flag) + +type ILFieldDef with + + member x.HasWellKnownAttribute(g: TcGlobals, flag: WellKnownILAttributes) = + x.CustomAttrsStored.HasWellKnownAttribute(g, flag) /// Analyze three cases for attributes declared on type definitions: IL-declared attributes, F#-declared attributes and /// provided attributes. diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 37655657ed6..d28c20003a7 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2374,6 +2374,25 @@ val TryFindILAttribute: BuiltinAttribInfo -> ILAttributes -> bool val TryFindILAttributeOpt: BuiltinAttribInfo option -> ILAttributes -> bool +/// Compute well-known attribute flags for an ILAttributes collection. +val computeILWellKnownFlags: g: TcGlobals -> attrs: ILAttributes -> WellKnownILAttributes + +type ILAttributesStored with + + member HasWellKnownAttribute: g: TcGlobals * flag: WellKnownILAttributes -> bool + +type ILTypeDef with + + member HasWellKnownAttribute: g: TcGlobals * flag: WellKnownILAttributes -> bool + +type ILMethodDef with + + member HasWellKnownAttribute: g: TcGlobals * flag: WellKnownILAttributes -> bool + +type ILFieldDef with + + member HasWellKnownAttribute: g: TcGlobals * flag: WellKnownILAttributes -> bool + val IsMatchingFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attrib -> bool val IsMatchingFSharpAttributeOpt: TcGlobals -> BuiltinAttribInfo option -> Attrib -> bool From 36da6136764ea9b0205f5966f30dfbab903b65df Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 20 Feb 2026 22:38:23 +0100 Subject: [PATCH 03/71] Fix IL Compute And Migration: scope-safe comparison, TypeHierarchy migration, remove dead enums - Fix computeILWellKnownFlags to use name+enclosing comparison (not full ILTypeRef equality with scope) matching isILAttrib semantics. This fixes silent failures when BCL reference assemblies use ILScopeRef.Local while TcGlobals uses ILScopeRef.Assembly. - Migrate TypeHierarchy.fs sites #6 and #7 (IsReadOnlyAttribute, RequiresLocationAttribute) to use HasWellKnownAttribute. - Remove unused WellKnownEntityAttributes and WellKnownValAttributes enums from TypedTree.fs/TypedTree.fsi (dead code not part of this sprint). - Update surface area baseline. - Run dotnet fantomas on all changed files. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/AbstractIL/il.fs | 6 +- src/Compiler/AbstractIL/il.fsi | 3 +- src/Compiler/Checking/TypeHierarchy.fs | 4 +- src/Compiler/TypedTree/TypedTree.fs | 62 ------------------- src/Compiler/TypedTree/TypedTree.fsi | 62 ------------------- src/Compiler/TypedTree/TypedTreeOps.fs | 43 +++++++------ ...iler.Service.SurfaceArea.netstandard20.bsl | 50 +++++++++------ 7 files changed, 61 insertions(+), 169 deletions(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index bd58f1dbc1d..ad3da5cbc6e 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -1288,8 +1288,7 @@ type ILAttributesStored private (metadataIndex: int32, initial: ILAttributesStor repr <- Computed(a, f) f - static member CreateReader(idx: int32, f: int32 -> ILAttribute[]) = - ILAttributesStored(idx, Reader f) + static member CreateReader(idx: int32, f: int32 -> ILAttribute[]) = ILAttributesStored(idx, Reader f) static member CreateGiven(attrs: ILAttributes) = ILAttributesStored(-1, Given attrs) @@ -1321,8 +1320,7 @@ let mkILCustomAttrsComputed f = let mkILCustomAttrsReader f = ILAttributesStored.CreateReader(-1, f) -let mkILCustomAttrsReaderWithIndex idx f = - ILAttributesStored.CreateReader(idx, f) +let mkILCustomAttrsReaderWithIndex idx f = ILAttributesStored.CreateReader(idx, f) type ILCodeLabel = int diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index eff249f5b01..84c47adfff9 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -909,8 +909,7 @@ type ILAttributesStored = member GetCustomAttrs: int32 -> ILAttributes member MetadataIndex: int32 - member HasWellKnownAttribute: - flag: WellKnownILAttributes * compute: (ILAttributes -> WellKnownILAttributes) -> bool + member HasWellKnownAttribute: flag: WellKnownILAttributes * compute: (ILAttributes -> WellKnownILAttributes) -> bool member GetOrComputeWellKnownFlags: compute: (ILAttributes -> WellKnownILAttributes) -> WellKnownILAttributes static member CreateReader: idx: int32 * f: (int32 -> ILAttribute[]) -> ILAttributesStored diff --git a/src/Compiler/Checking/TypeHierarchy.fs b/src/Compiler/Checking/TypeHierarchy.fs index 9b35a7f9497..ec788a3204a 100644 --- a/src/Compiler/Checking/TypeHierarchy.fs +++ b/src/Compiler/Checking/TypeHierarchy.fs @@ -377,8 +377,8 @@ let ImportILTypeFromMetadataWithAttributes amap m scoref tinst minst nullnessSou let (AttributesFromIL(_, storedAttrs)) = nullnessSource.DirectAttributes if isByrefTy amap.g ty - && (TryFindILAttribute amap.g.attrib_IsReadOnlyAttribute storedAttrs.CustomAttrs - || TryFindILAttribute amap.g.attrib_RequiresLocationAttribute storedAttrs.CustomAttrs) then + && (storedAttrs.HasWellKnownAttribute(amap.g, WellKnownILAttributes.IsReadOnlyAttribute) + || storedAttrs.HasWellKnownAttribute(amap.g, WellKnownILAttributes.RequiresLocationAttribute)) then mkInByrefTy amap.g (destByrefTy amap.g ty) else ty diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 4e641fc56cb..b08823c2734 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -4627,68 +4627,6 @@ type Measure = | One(range= m) -> m | RationalPower(measure= ms) -> ms.Range -[] -type WellKnownEntityAttributes = - | None = 0UL - | RequireQualifiedAccessAttribute = 0x1UL - | AutoOpenAttribute = 0x2UL - | AbstractClassAttribute = 0x4UL - | SealedAttribute = 0x8UL - | NoEqualityAttribute = 0x10UL - | NoComparisonAttribute = 0x20UL - | StructuralEqualityAttribute = 0x40UL - | StructuralComparisonAttribute = 0x80UL - | CustomEqualityAttribute = 0x100UL - | CustomComparisonAttribute = 0x200UL - | ReferenceEqualityAttribute = 0x400UL - | DefaultAugmentationAttribute = 0x800UL - | CLIMutableAttribute = 0x1000UL - | AutoSerializableAttribute = 0x2000UL - | StructLayoutAttribute = 0x4000UL - | DllImportAttribute = 0x8000UL - | ReflectedDefinitionAttribute = 0x10000UL - | GeneralizableValueAttribute = 0x20000UL - | SkipLocalsInitAttribute = 0x40000UL - | DebuggerTypeProxyAttribute = 0x80000UL - | ComVisibleAttribute = 0x100000UL - | IsReadOnlyAttribute = 0x200000UL - | IsByRefLikeAttribute = 0x400000UL - | ExtensionAttribute = 0x800000UL - | AttributeUsageAttribute = 0x1000000UL - | WarnOnWithoutNullArgumentAttribute = 0x2000000UL - | AllowNullLiteralAttribute = 0x4000000UL - | NotComputed = 0x8000000000000000UL - -[] -type WellKnownValAttributes = - | None = 0UL - | DllImportAttribute = 0x1UL - | EntryPointAttribute = 0x2UL - | LiteralAttribute = 0x4UL - | ConditionalAttribute = 0x8UL - | ReflectedDefinitionAttribute = 0x10UL - | RequiresExplicitTypeArgumentsAttribute = 0x20UL - | DefaultValueAttribute = 0x40UL - | SkipLocalsInitAttribute = 0x80UL - | ThreadStaticAttribute = 0x100UL - | ContextStaticAttribute = 0x200UL - | VolatileFieldAttribute = 0x400UL - | NoDynamicInvocationAttribute = 0x800UL - | ExtensionAttribute = 0x1000UL - | OptionalArgumentAttribute = 0x2000UL - | InAttribute = 0x4000UL - | OutAttribute = 0x8000UL - | ParamArrayAttribute = 0x10000UL - | CallerMemberNameAttribute = 0x20000UL - | CallerFilePathAttribute = 0x40000UL - | CallerLineNumberAttribute = 0x80000UL - | DefaultParameterValueAttribute = 0x100000UL - | ProjectionParameterAttribute = 0x200000UL - | InlineIfLambdaAttribute = 0x400000UL - | OptionalAttribute = 0x800000UL - | StructAttribute = 0x1000000UL - | NotComputed = 0x8000000000000000UL - type Attribs = Attrib list [] diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index 49c0f96df36..3fe7c5b1c90 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -3234,68 +3234,6 @@ type Measure = member Range: range -[] -type WellKnownEntityAttributes = - | None = 0UL - | RequireQualifiedAccessAttribute = 0x1UL - | AutoOpenAttribute = 0x2UL - | AbstractClassAttribute = 0x4UL - | SealedAttribute = 0x8UL - | NoEqualityAttribute = 0x10UL - | NoComparisonAttribute = 0x20UL - | StructuralEqualityAttribute = 0x40UL - | StructuralComparisonAttribute = 0x80UL - | CustomEqualityAttribute = 0x100UL - | CustomComparisonAttribute = 0x200UL - | ReferenceEqualityAttribute = 0x400UL - | DefaultAugmentationAttribute = 0x800UL - | CLIMutableAttribute = 0x1000UL - | AutoSerializableAttribute = 0x2000UL - | StructLayoutAttribute = 0x4000UL - | DllImportAttribute = 0x8000UL - | ReflectedDefinitionAttribute = 0x10000UL - | GeneralizableValueAttribute = 0x20000UL - | SkipLocalsInitAttribute = 0x40000UL - | DebuggerTypeProxyAttribute = 0x80000UL - | ComVisibleAttribute = 0x100000UL - | IsReadOnlyAttribute = 0x200000UL - | IsByRefLikeAttribute = 0x400000UL - | ExtensionAttribute = 0x800000UL - | AttributeUsageAttribute = 0x1000000UL - | WarnOnWithoutNullArgumentAttribute = 0x2000000UL - | AllowNullLiteralAttribute = 0x4000000UL - | NotComputed = 0x8000000000000000UL - -[] -type WellKnownValAttributes = - | None = 0UL - | DllImportAttribute = 0x1UL - | EntryPointAttribute = 0x2UL - | LiteralAttribute = 0x4UL - | ConditionalAttribute = 0x8UL - | ReflectedDefinitionAttribute = 0x10UL - | RequiresExplicitTypeArgumentsAttribute = 0x20UL - | DefaultValueAttribute = 0x40UL - | SkipLocalsInitAttribute = 0x80UL - | ThreadStaticAttribute = 0x100UL - | ContextStaticAttribute = 0x200UL - | VolatileFieldAttribute = 0x400UL - | NoDynamicInvocationAttribute = 0x800UL - | ExtensionAttribute = 0x1000UL - | OptionalArgumentAttribute = 0x2000UL - | InAttribute = 0x4000UL - | OutAttribute = 0x8000UL - | ParamArrayAttribute = 0x10000UL - | CallerMemberNameAttribute = 0x20000UL - | CallerFilePathAttribute = 0x40000UL - | CallerLineNumberAttribute = 0x80000UL - | DefaultParameterValueAttribute = 0x100000UL - | ProjectionParameterAttribute = 0x200000UL - | InlineIfLambdaAttribute = 0x400000UL - | OptionalAttribute = 0x800000UL - | StructAttribute = 0x1000000UL - | NotComputed = 0x8000000000000000UL - type Attribs = Attrib list [] diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index c99b8833475..afb9c21ef9c 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3637,52 +3637,57 @@ let computeILWellKnownFlags (g: TcGlobals) (attrs: ILAttributes) : WellKnownILAt let (AttribInfo(nullableRef, _)) = g.attrib_NullableAttribute let (AttribInfo(noEagerConstraintRef, _)) = g.attrib_NoEagerConstraintApplicationAttribute + // Compare by name and enclosing only (not scope), matching isILAttrib semantics. + // BCL reference assemblies may use ILScopeRef.Local while TcGlobals uses ILScopeRef.Assembly. + let inline nameMatch (a: ILTypeRef) (b: ILTypeRef) = + a.Name = b.Name && a.Enclosing = b.Enclosing + for attr in attrs.AsArray() do let atref = attr.Method.DeclaringType.TypeSpec.TypeRef - if atref = isReadOnlyRef then + if nameMatch atref isReadOnlyRef then flags <- flags ||| WellKnownILAttributes.IsReadOnlyAttribute - elif atref = isUnmanagedRef then + elif nameMatch atref isUnmanagedRef then flags <- flags ||| WellKnownILAttributes.IsUnmanagedAttribute - elif atref = extensionRef then + elif nameMatch atref extensionRef then flags <- flags ||| WellKnownILAttributes.ExtensionAttribute - elif atref = paramArrayRef then + elif nameMatch atref paramArrayRef then flags <- flags ||| WellKnownILAttributes.ParamArrayAttribute - elif atref = allowNullLiteralRef then + elif nameMatch atref allowNullLiteralRef then flags <- flags ||| WellKnownILAttributes.AllowNullLiteralAttribute - elif atref = reflectedDefRef then + elif nameMatch atref reflectedDefRef then flags <- flags ||| WellKnownILAttributes.ReflectedDefinitionAttribute - elif atref = autoOpenRef then + elif nameMatch atref autoOpenRef then flags <- flags ||| WellKnownILAttributes.AutoOpenAttribute - elif atref = internalsVisibleToRef then + elif nameMatch atref internalsVisibleToRef then flags <- flags ||| WellKnownILAttributes.InternalsVisibleToAttribute - elif atref = callerMemberNameRef then + elif nameMatch atref callerMemberNameRef then flags <- flags ||| WellKnownILAttributes.CallerMemberNameAttribute - elif atref = callerFilePathRef then + elif nameMatch atref callerFilePathRef then flags <- flags ||| WellKnownILAttributes.CallerFilePathAttribute - elif atref = callerLineNumberRef then + elif nameMatch atref callerLineNumberRef then flags <- flags ||| WellKnownILAttributes.CallerLineNumberAttribute - elif atref = defaultMemberRef then + elif nameMatch atref defaultMemberRef then flags <- flags ||| WellKnownILAttributes.DefaultMemberAttribute - elif atref = setsRequiredMembersRef then + elif nameMatch atref setsRequiredMembersRef then flags <- flags ||| WellKnownILAttributes.SetsRequiredMembersAttribute - elif atref = requiresLocationRef then + elif nameMatch atref requiresLocationRef then flags <- flags ||| WellKnownILAttributes.RequiresLocationAttribute - elif atref = nullableRef then + elif nameMatch atref nullableRef then flags <- flags ||| WellKnownILAttributes.NullableAttribute - elif atref = noEagerConstraintRef then + elif nameMatch atref noEagerConstraintRef then flags <- flags ||| WellKnownILAttributes.NoEagerConstraintApplicationAttribute else match g.attrib_IsByRefLikeAttribute_opt with - | Some(AttribInfo(r, _)) when atref = r -> + | Some(AttribInfo(r, _)) when nameMatch atref r -> flags <- flags ||| WellKnownILAttributes.IsByRefLikeAttribute | _ -> match g.attrib_IDispatchConstantAttribute with - | Some(AttribInfo(r, _)) when atref = r -> + | Some(AttribInfo(r, _)) when nameMatch atref r -> flags <- flags ||| WellKnownILAttributes.IDispatchConstantAttribute | _ -> match g.attrib_IUnknownConstantAttribute with - | Some(AttribInfo(r, _)) when atref = r -> + | Some(AttribInfo(r, _)) when nameMatch atref r -> flags <- flags ||| WellKnownILAttributes.IUnknownConstantAttribute | _ -> () diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl index feecc4eecd8..2b870b4c448 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl @@ -301,25 +301,16 @@ FSharp.Compiler.AbstractIL.IL+ILAttribute: Int32 get_Tag() FSharp.Compiler.AbstractIL.IL+ILAttribute: System.String ToString() FSharp.Compiler.AbstractIL.IL+ILAttributes: ILAttribute[] AsArray() FSharp.Compiler.AbstractIL.IL+ILAttributes: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+ILAttribute] AsList() -FSharp.Compiler.AbstractIL.IL+ILAttributesStored+Given: ILAttributes Item -FSharp.Compiler.AbstractIL.IL+ILAttributesStored+Given: ILAttributes get_Item() -FSharp.Compiler.AbstractIL.IL+ILAttributesStored+Reader: Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,FSharp.Compiler.AbstractIL.IL+ILAttribute[]] Item -FSharp.Compiler.AbstractIL.IL+ILAttributesStored+Reader: Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,FSharp.Compiler.AbstractIL.IL+ILAttribute[]] get_Item() -FSharp.Compiler.AbstractIL.IL+ILAttributesStored+Tags: Int32 Given -FSharp.Compiler.AbstractIL.IL+ILAttributesStored+Tags: Int32 Reader -FSharp.Compiler.AbstractIL.IL+ILAttributesStored: Boolean IsGiven -FSharp.Compiler.AbstractIL.IL+ILAttributesStored: Boolean IsReader -FSharp.Compiler.AbstractIL.IL+ILAttributesStored: Boolean get_IsGiven() -FSharp.Compiler.AbstractIL.IL+ILAttributesStored: Boolean get_IsReader() -FSharp.Compiler.AbstractIL.IL+ILAttributesStored: FSharp.Compiler.AbstractIL.IL+ILAttributesStored+Given -FSharp.Compiler.AbstractIL.IL+ILAttributesStored: FSharp.Compiler.AbstractIL.IL+ILAttributesStored+Reader -FSharp.Compiler.AbstractIL.IL+ILAttributesStored: FSharp.Compiler.AbstractIL.IL+ILAttributesStored+Tags +FSharp.Compiler.AbstractIL.IL+ILAttributesStored: Boolean HasWellKnownAttribute(WellKnownILAttributes, Microsoft.FSharp.Core.FSharpFunc`2[FSharp.Compiler.AbstractIL.IL+ILAttributes,FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes]) +FSharp.Compiler.AbstractIL.IL+ILAttributesStored: ILAttributes CustomAttrs FSharp.Compiler.AbstractIL.IL+ILAttributesStored: ILAttributes GetCustomAttrs(Int32) -FSharp.Compiler.AbstractIL.IL+ILAttributesStored: ILAttributesStored NewGiven(ILAttributes) -FSharp.Compiler.AbstractIL.IL+ILAttributesStored: ILAttributesStored NewReader(Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,FSharp.Compiler.AbstractIL.IL+ILAttribute[]]) -FSharp.Compiler.AbstractIL.IL+ILAttributesStored: Int32 Tag -FSharp.Compiler.AbstractIL.IL+ILAttributesStored: Int32 get_Tag() -FSharp.Compiler.AbstractIL.IL+ILAttributesStored: System.String ToString() +FSharp.Compiler.AbstractIL.IL+ILAttributesStored: ILAttributes get_CustomAttrs() +FSharp.Compiler.AbstractIL.IL+ILAttributesStored: ILAttributesStored CreateGiven(ILAttributes) +FSharp.Compiler.AbstractIL.IL+ILAttributesStored: ILAttributesStored CreateGiven(Int32, ILAttributes) +FSharp.Compiler.AbstractIL.IL+ILAttributesStored: ILAttributesStored CreateReader(Int32, Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,FSharp.Compiler.AbstractIL.IL+ILAttribute[]]) +FSharp.Compiler.AbstractIL.IL+ILAttributesStored: Int32 MetadataIndex +FSharp.Compiler.AbstractIL.IL+ILAttributesStored: Int32 get_MetadataIndex() +FSharp.Compiler.AbstractIL.IL+ILAttributesStored: WellKnownILAttributes GetOrComputeWellKnownFlags(Microsoft.FSharp.Core.FSharpFunc`2[FSharp.Compiler.AbstractIL.IL+ILAttributes,FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes]) FSharp.Compiler.AbstractIL.IL+ILCallingConv: Boolean Equals(ILCallingConv) FSharp.Compiler.AbstractIL.IL+ILCallingConv: Boolean Equals(ILCallingConv, System.Collections.IEqualityComparer) FSharp.Compiler.AbstractIL.IL+ILCallingConv: Boolean Equals(System.Object) @@ -1827,6 +1818,28 @@ FSharp.Compiler.AbstractIL.IL+PublicKey: PublicKey KeyAsToken(Byte[]) FSharp.Compiler.AbstractIL.IL+PublicKey: PublicKey NewPublicKey(Byte[]) FSharp.Compiler.AbstractIL.IL+PublicKey: PublicKey NewPublicKeyToken(Byte[]) FSharp.Compiler.AbstractIL.IL+PublicKey: System.String ToString() +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: UInt32 value__ +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes AllowNullLiteralAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes AutoOpenAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes CallerFilePathAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes CallerLineNumberAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes CallerMemberNameAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes DefaultMemberAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes ExtensionAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes IDispatchConstantAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes IUnknownConstantAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes InternalsVisibleToAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes IsByRefLikeAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes IsReadOnlyAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes IsUnmanagedAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes NoEagerConstraintApplicationAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes None +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes NotComputed +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes NullableAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes ParamArrayAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes ReflectedDefinitionAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes RequiresLocationAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes SetsRequiredMembersAttribute FSharp.Compiler.AbstractIL.IL: Boolean |HasFlag|_|(ILTypeDefAdditionalFlags, ILTypeDefAdditionalFlags) FSharp.Compiler.AbstractIL.IL: FSharp.Compiler.AbstractIL.IL+ILArgConvention FSharp.Compiler.AbstractIL.IL: FSharp.Compiler.AbstractIL.IL+ILArrayShape @@ -1891,6 +1904,7 @@ FSharp.Compiler.AbstractIL.IL: FSharp.Compiler.AbstractIL.IL+ILVersionInfo FSharp.Compiler.AbstractIL.IL: FSharp.Compiler.AbstractIL.IL+InterfaceImpl FSharp.Compiler.AbstractIL.IL: FSharp.Compiler.AbstractIL.IL+MethodBody FSharp.Compiler.AbstractIL.IL: FSharp.Compiler.AbstractIL.IL+PublicKey +FSharp.Compiler.AbstractIL.IL: FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes FSharp.Compiler.AbstractIL.IL: ILAttributes emptyILCustomAttrs FSharp.Compiler.AbstractIL.IL: ILAttributes get_emptyILCustomAttrs() FSharp.Compiler.AbstractIL.IL: ILAttributes mkILCustomAttrs(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+ILAttribute]) From 8d3794161c5117e26028cab3f972bea6239df874 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 20 Feb 2026 23:32:50 +0100 Subject: [PATCH 04/71] Add WellKnownEntityAttribs struct and migrate Entity.entity_attribs Sprint 2: Entity Container And Infrastructure - Add WellKnownEntityAttributes flags enum (27 flags + NotComputed sentinel) - Add WellKnownEntityAttribs struct wrapper with O(1) attribute lookup - Change Entity.entity_attribs field type from Attribs to WellKnownEntityAttribs - Entity.Attribs still returns Attrib list via .AsList() - Add Entity.EntityAttribs and Entity.SetEntityAttribs members - Fix Entity.IsLinked for struct field (null check on AsList()) - Add computeEntityWellKnownFlags and EntityHasWellKnownAttribute in TypedTreeOps - Update TypedTreePickle.fs to pickle/unpickle through the wrapper - Update all entity_attribs assignments across the compiler Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/CheckDeclarations.fs | 8 +- src/Compiler/Checking/SignatureConformance.fs | 2 +- src/Compiler/TypedTree/TypedTree.fs | 98 +++++++++++++++++-- src/Compiler/TypedTree/TypedTree.fsi | 56 ++++++++++- src/Compiler/TypedTree/TypedTreeOps.fs | 95 ++++++++++++++++-- src/Compiler/TypedTree/TypedTreeOps.fsi | 6 ++ src/Compiler/TypedTree/TypedTreePickle.fs | 4 +- 7 files changed, 247 insertions(+), 22 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index beeaa83e4d5..4d749700358 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -3294,7 +3294,7 @@ module EstablishTypeDefinitionCores = let implementedTys, _ = List.mapFold (mapFoldFst (TcTypeAndRecover cenv NoNewTypars checkConstraints ItemOccurrence.UseInType WarnOnIWSAM.No envinner)) tpenv explicitImplements if firstPass then - tycon.entity_attribs <- attrs + tycon.entity_attribs <- WellKnownEntityAttribs.Create(attrs) let implementedTys, inheritedTys = match synTyconRepr with @@ -3421,7 +3421,7 @@ module EstablishTypeDefinitionCores = if hasAbstractAttr then tycon.TypeContents.tcaug_abstract <- true - tycon.entity_attribs <- attrs + tycon.entity_attribs <- WellKnownEntityAttribs.Create(attrs) let noAbstractClassAttributeCheck() = if hasAbstractAttr then errorR (Error(FSComp.SR.tcOnlyClassesCanHaveAbstract(), m)) @@ -4177,7 +4177,7 @@ module EstablishTypeDefinitionCores = let tyconOpt, fixupFinalAttrs = match tyconAndAttrsOpt with | None -> None, (fun () -> ()) - | Some (tycon, (_prelimAttrs, getFinalAttrs)) -> Some tycon, (fun () -> tycon.entity_attribs <- getFinalAttrs()) + | Some (tycon, (_prelimAttrs, getFinalAttrs)) -> Some tycon, (fun () -> tycon.entity_attribs <- WellKnownEntityAttribs.Create(getFinalAttrs())) (origInfo, tyconOpt, fixupFinalAttrs, info)) @@ -4813,7 +4813,7 @@ module TcDeclarations = match extensionAttributeOnVals, typeEntity with | Some extensionAttribute, Some typeEntity -> if Option.isNone (tryFindExtensionAttribute g typeEntity.Attribs) then - typeEntity.entity_attribs <- extensionAttribute :: typeEntity.Attribs + typeEntity.entity_attribs <- WellKnownEntityAttribs.Create(extensionAttribute :: typeEntity.Attribs) | _ -> () vals, env diff --git a/src/Compiler/Checking/SignatureConformance.fs b/src/Compiler/Checking/SignatureConformance.fs index f6c575cbb4f..bc1d5fad2e4 100644 --- a/src/Compiler/Checking/SignatureConformance.fs +++ b/src/Compiler/Checking/SignatureConformance.fs @@ -279,7 +279,7 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = checkTypars m aenv implTypars sigTypars && checkTypeRepr m aenv infoReader implTycon sigTycon && checkTypeAbbrev m aenv implTycon sigTycon && - checkAttribs aenv implTycon.Attribs sigTycon.Attribs (fun attribs -> implTycon.entity_attribs <- attribs) && + checkAttribs aenv implTycon.Attribs sigTycon.Attribs (fun attribs -> implTycon.entity_attribs <- WellKnownEntityAttribs.Create(attribs)) && checkModuleOrNamespaceContents implTycon.Range aenv infoReader (mkLocalEntityRef implTycon) sigTycon.ModuleOrNamespaceType and checkValInfo aenv err (implVal : Val) (sigVal : Val) = diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index b08823c2734..aadee16004f 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -648,7 +648,7 @@ type Entity = /// The declared attributes for the type // MUTABILITY; used during creation and remapping of tycons // MUTABILITY; used when propagating signature attributes into the implementation. - mutable entity_attribs: Attribs + mutable entity_attribs: WellKnownEntityAttribs /// The declared representation of the type, i.e. record, union, class etc. // @@ -813,7 +813,9 @@ type Entity = /// The F#-defined custom attributes of the entity, if any. If the entity is backed by Abstract IL or provided metadata /// then this does not include any attributes from those sources. - member x.Attribs = x.entity_attribs + member x.Attribs = x.entity_attribs.AsList() + + member x.EntityAttribs = x.entity_attribs /// The XML documentation of the entity, if any. If the entity is backed by provided metadata /// then this _does_ include this documentation. If the entity is backed by Abstract IL metadata @@ -1105,7 +1107,7 @@ type Entity = /// Indicates if the entity is linked to backing data. Only used during unpickling of F# metadata. - member x.IsLinked = match box x.entity_attribs with null -> false | _ -> true + member x.IsLinked = not (obj.ReferenceEquals(x.entity_attribs.AsList(), null)) /// Get the blob of information associated with an F# object-model type definition, i.e. class, interface, struct etc. member x.FSharpTyconRepresentationData = @@ -1350,7 +1352,9 @@ type Entity = member x.HasSignatureFile = x.SigRange <> x.DefinitionRange /// Set the custom attributes on an F# type definition. - member x.SetAttribs attribs = x.entity_attribs <- attribs + member x.SetAttribs attribs = x.entity_attribs <- WellKnownEntityAttribs.Create(attribs) + + member x.SetEntityAttribs (attribs: WellKnownEntityAttribs) = x.entity_attribs <- attribs /// Sets the structness of a record or union type definition member x.SetIsStructRecordOrUnion b = let flags = x.entity_flags in x.entity_flags <- EntityFlags(flags.IsPrefixDisplay, flags.IsModuleOrNamespace, flags.PreEstablishedHasDefaultConstructor, flags.HasSelfReferentialConstructor, b) @@ -4627,6 +4631,84 @@ type Measure = | One(range= m) -> m | RationalPower(measure= ms) -> ms.Range +/// Flags enum for well-known attributes on Entity (types and modules). +/// Used to avoid O(N) linear scans of attribute lists. +[] +type WellKnownEntityAttributes = + | None = 0u + | RequireQualifiedAccessAttribute = 0x1u + | AutoOpenAttribute = 0x2u + | AbstractClassAttribute = 0x4u + | SealedAttribute = 0x8u + | NoEqualityAttribute = 0x10u + | NoComparisonAttribute = 0x20u + | StructuralEqualityAttribute = 0x40u + | StructuralComparisonAttribute = 0x80u + | CustomEqualityAttribute = 0x100u + | CustomComparisonAttribute = 0x200u + | ReferenceEqualityAttribute = 0x400u + | DefaultAugmentationAttribute = 0x800u + | CLIMutableAttribute = 0x1000u + | AutoSerializableAttribute = 0x2000u + | StructLayoutAttribute = 0x4000u + | DllImportAttribute = 0x8000u + | ReflectedDefinitionAttribute = 0x10000u + | GeneralizableValueAttribute = 0x20000u + | SkipLocalsInitAttribute = 0x40000u + | DebuggerTypeProxyAttribute = 0x80000u + | ComVisibleAttribute = 0x100000u + | IsReadOnlyAttribute = 0x200000u + | IsByRefLikeAttribute = 0x400000u + | ExtensionAttribute = 0x800000u + | AttributeUsageAttribute = 0x1000000u + | WarnOnWithoutNullArgumentAttribute = 0x2000000u + | AllowNullLiteralAttribute = 0x4000000u + | NotComputed = 0x80000000u + +/// Wraps an Attrib list together with cached WellKnownEntityAttributes flags for O(1) lookup. +[] +type WellKnownEntityAttribs = + val private attribs: Attrib list + val private flags: WellKnownEntityAttributes + + new(attribs: Attrib list, flags: WellKnownEntityAttributes) = { attribs = attribs; flags = flags } + + /// Check if a specific well-known attribute flag is set. + member x.HasWellKnownAttribute(flag: WellKnownEntityAttributes) : bool = + x.flags &&& flag <> WellKnownEntityAttributes.None + + /// Get the underlying attribute list (for remap/display/serialization/full-data extraction). + member x.AsList() = x.attribs + + /// Get the current flags value. + member x.Flags = x.flags + + /// Create from an attribute list. If empty, flags = None. Otherwise NotComputed. + static member Create(attribs: Attrib list) = + if attribs.IsEmpty then + WellKnownEntityAttribs([], WellKnownEntityAttributes.None) + else + WellKnownEntityAttribs(attribs, WellKnownEntityAttributes.NotComputed) + + /// Create with precomputed flags (used when flags are already known). + static member CreateWithFlags(attribs: Attrib list, flags: WellKnownEntityAttributes) = + WellKnownEntityAttribs(attribs, flags) + + /// Add a single attribute and OR-in its flag. + member x.Add(attrib: Attrib, flag: WellKnownEntityAttributes) = + WellKnownEntityAttribs(attrib :: x.attribs, x.flags ||| flag) + + /// Append attributes and OR-in flags. + member x.Append(others: Attrib list, flags: WellKnownEntityAttributes) = + WellKnownEntityAttribs(x.attribs @ others, x.flags ||| flags) + + /// Returns a copy with recomputed flags (flags set to NotComputed). + member x.WithRecomputedFlags() = + if x.attribs.IsEmpty then + WellKnownEntityAttribs([], WellKnownEntityAttributes.None) + else + WellKnownEntityAttribs(x.attribs, WellKnownEntityAttributes.NotComputed) + type Attribs = Attrib list [] @@ -6132,7 +6214,7 @@ type Construct() = entity_logical_name=name entity_range=m entity_flags=EntityFlags(usesPrefixDisplay=false, isModuleOrNamespace=false, preEstablishedHasDefaultCtor=false, hasSelfReferentialCtor=false, isStructRecordOrUnionType=false) - entity_attribs=[] // fetched on demand via est.fs API + entity_attribs=WellKnownEntityAttribs.Create([]) // fetched on demand via est.fs API entity_typars= LazyWithContext.NotLazy [] entity_tycon_repr = repr entity_tycon_tcaug=TyconAugmentation.Create() @@ -6164,7 +6246,7 @@ type Construct() = entity_tycon_tcaug=TyconAugmentation.Create() entity_pubpath=cpath |> Option.map (fun (cp: CompilationPath) -> cp.NestedPublicPath id) entity_cpath=cpath - entity_attribs=attribs + entity_attribs=WellKnownEntityAttribs.Create(attribs) entity_il_repr_cache = newCache() entity_opt_data = match xml, access with @@ -6233,7 +6315,7 @@ type Construct() = static member NewExn cpath (id: Ident) access repr attribs (doc: XmlDoc) = Tycon.New "exnc" { entity_stamp = newStamp() - entity_attribs = attribs + entity_attribs = WellKnownEntityAttribs.Create(attribs) entity_logical_name = id.idText entity_range = id.idRange entity_tycon_tcaug = TyconAugmentation.Create() @@ -6275,7 +6357,7 @@ type Construct() = entity_logical_name=nm entity_range=m entity_flags=EntityFlags(usesPrefixDisplay=usesPrefixDisplay, isModuleOrNamespace=false, preEstablishedHasDefaultCtor=preEstablishedHasDefaultCtor, hasSelfReferentialCtor=hasSelfReferentialCtor, isStructRecordOrUnionType=false) - entity_attribs=[] // fixed up after + entity_attribs=WellKnownEntityAttribs.Create([]) // fixed up after entity_typars=typars entity_tycon_repr = TNoRepr entity_tycon_tcaug=TyconAugmentation.Create() diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index 3fe7c5b1c90..bed253cd80f 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -423,7 +423,7 @@ type Entity = mutable entity_range: range /// The declared attributes for the type - mutable entity_attribs: Attribs + mutable entity_attribs: WellKnownEntityAttribs /// The declared representation of the type, i.e. record, union, class etc. mutable entity_tycon_repr: TyconRepresentation @@ -471,6 +471,9 @@ type Entity = /// Set the custom attributes on an F# type definition. member SetAttribs: attribs: Attribs -> unit + /// Set the custom attributes wrapper on an F# type definition. + member SetEntityAttribs: WellKnownEntityAttribs -> unit + member SetCompiledName: name: string option -> unit member SetExceptionInfo: exn_info: ExceptionInfo -> unit @@ -528,6 +531,9 @@ type Entity = /// then this does not include any attributes from those sources. member Attribs: Attribs + /// The wrapped F#-defined custom attributes of the entity with cached well-known flags. + member EntityAttribs: WellKnownEntityAttribs + /// Get a blob of data indicating how this type is nested inside other namespaces, modules type types. member CompilationPath: CompilationPath @@ -3234,6 +3240,54 @@ type Measure = member Range: range +/// Flags enum for well-known attributes on Entity (types and modules). +[] +type WellKnownEntityAttributes = + | None = 0u + | RequireQualifiedAccessAttribute = 0x1u + | AutoOpenAttribute = 0x2u + | AbstractClassAttribute = 0x4u + | SealedAttribute = 0x8u + | NoEqualityAttribute = 0x10u + | NoComparisonAttribute = 0x20u + | StructuralEqualityAttribute = 0x40u + | StructuralComparisonAttribute = 0x80u + | CustomEqualityAttribute = 0x100u + | CustomComparisonAttribute = 0x200u + | ReferenceEqualityAttribute = 0x400u + | DefaultAugmentationAttribute = 0x800u + | CLIMutableAttribute = 0x1000u + | AutoSerializableAttribute = 0x2000u + | StructLayoutAttribute = 0x4000u + | DllImportAttribute = 0x8000u + | ReflectedDefinitionAttribute = 0x10000u + | GeneralizableValueAttribute = 0x20000u + | SkipLocalsInitAttribute = 0x40000u + | DebuggerTypeProxyAttribute = 0x80000u + | ComVisibleAttribute = 0x100000u + | IsReadOnlyAttribute = 0x200000u + | IsByRefLikeAttribute = 0x400000u + | ExtensionAttribute = 0x800000u + | AttributeUsageAttribute = 0x1000000u + | WarnOnWithoutNullArgumentAttribute = 0x2000000u + | AllowNullLiteralAttribute = 0x4000000u + | NotComputed = 0x80000000u + +/// Wraps an Attrib list together with cached WellKnownEntityAttributes flags for O(1) lookup. +[] +type WellKnownEntityAttribs = + val private attribs: Attrib list + val private flags: WellKnownEntityAttributes + new: attribs: Attrib list * flags: WellKnownEntityAttributes -> WellKnownEntityAttribs + member HasWellKnownAttribute: flag: WellKnownEntityAttributes -> bool + member AsList: unit -> Attrib list + member Flags: WellKnownEntityAttributes + static member Create: attribs: Attrib list -> WellKnownEntityAttribs + static member CreateWithFlags: attribs: Attrib list * flags: WellKnownEntityAttributes -> WellKnownEntityAttribs + member Add: attrib: Attrib * flag: WellKnownEntityAttributes -> WellKnownEntityAttribs + member Append: others: Attrib list * flags: WellKnownEntityAttributes -> WellKnownEntityAttribs + member WithRecomputedFlags: unit -> WellKnownEntityAttribs + type Attribs = Attrib list [] diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index afb9c21ef9c..49aa2190c41 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3713,6 +3713,89 @@ type ILFieldDef with member x.HasWellKnownAttribute(g: TcGlobals, flag: WellKnownILAttributes) = x.CustomAttrsStored.HasWellKnownAttribute(g, flag) +/// Compute well-known attribute flags for an Entity's Attrib list. +let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEntityAttributes = + let mutable flags = WellKnownEntityAttributes.None + + for attrib in attribs do + let (Attrib(tcref, _, _, _, _, _, _)) = attrib + + if tyconRefEq g tcref g.attrib_RequireQualifiedAccessAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.RequireQualifiedAccessAttribute + elif tyconRefEq g tcref g.attrib_AutoOpenAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.AutoOpenAttribute + elif tyconRefEq g tcref g.attrib_AbstractClassAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.AbstractClassAttribute + elif tyconRefEq g tcref g.attrib_SealedAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.SealedAttribute + elif tyconRefEq g tcref g.attrib_NoEqualityAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.NoEqualityAttribute + elif tyconRefEq g tcref g.attrib_NoComparisonAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.NoComparisonAttribute + elif tyconRefEq g tcref g.attrib_StructuralEqualityAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.StructuralEqualityAttribute + elif tyconRefEq g tcref g.attrib_StructuralComparisonAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.StructuralComparisonAttribute + elif tyconRefEq g tcref g.attrib_CustomEqualityAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.CustomEqualityAttribute + elif tyconRefEq g tcref g.attrib_CustomComparisonAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.CustomComparisonAttribute + elif tyconRefEq g tcref g.attrib_ReferenceEqualityAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.ReferenceEqualityAttribute + elif tyconRefEq g tcref g.attrib_DefaultAugmentationAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.DefaultAugmentationAttribute + elif tyconRefEq g tcref g.attrib_CLIMutableAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.CLIMutableAttribute + elif tyconRefEq g tcref g.attrib_AutoSerializableAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.AutoSerializableAttribute + elif tyconRefEq g tcref g.attrib_StructLayoutAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.StructLayoutAttribute + elif + (match g.attrib_DllImportAttribute with + | Some a -> tyconRefEq g tcref a.TyconRef + | None -> false) + then + flags <- flags ||| WellKnownEntityAttributes.DllImportAttribute + elif tyconRefEq g tcref g.attrib_ReflectedDefinitionAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.ReflectedDefinitionAttribute + elif tyconRefEq g tcref g.attrib_GeneralizableValueAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.GeneralizableValueAttribute + elif tyconRefEq g tcref g.attrib_SkipLocalsInitAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.SkipLocalsInitAttribute + elif tyconRefEq g tcref g.attrib_DebuggerTypeProxyAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.DebuggerTypeProxyAttribute + elif tyconRefEq g tcref g.attrib_ComVisibleAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.ComVisibleAttribute + elif tyconRefEq g tcref g.attrib_IsReadOnlyAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.IsReadOnlyAttribute + elif + (match g.attrib_IsByRefLikeAttribute_opt with + | Some a -> tyconRefEq g tcref a.TyconRef + | None -> false) + then + flags <- flags ||| WellKnownEntityAttributes.IsByRefLikeAttribute + elif tyconRefEq g tcref g.attrib_ExtensionAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.ExtensionAttribute + elif tyconRefEq g tcref g.attrib_AttributeUsageAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.AttributeUsageAttribute + elif tyconRefEq g tcref g.attrib_WarnOnWithoutNullArgumentAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.WarnOnWithoutNullArgumentAttribute + elif tyconRefEq g tcref g.attrib_AllowNullLiteralAttribute.TyconRef then + flags <- flags ||| WellKnownEntityAttributes.AllowNullLiteralAttribute + + flags + +/// Check if an Entity has a specific well-known attribute, computing and caching flags if needed. +let EntityHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownEntityAttributes) (entity: Entity) : bool = + let ea = entity.EntityAttribs + + if ea.Flags &&& WellKnownEntityAttributes.NotComputed <> WellKnownEntityAttributes.None then + let flags = computeEntityWellKnownFlags g (ea.AsList()) + entity.SetEntityAttribs(WellKnownEntityAttribs.CreateWithFlags(ea.AsList(), flags)) + flags &&& flag <> WellKnownEntityAttributes.None + else + ea.HasWellKnownAttribute(flag) + /// Analyze three cases for attributes declared on type definitions: IL-declared attributes, F#-declared attributes and /// provided attributes. // @@ -6529,7 +6612,7 @@ and copyAndRemapAndBindTyconsAndVals ctxt compgen tmenv tycons vs = let lookupTycon tycon = lookupTycon tycon let tpsR, tmenvinner2 = tmenvCopyRemapAndBindTypars (remapAttribs ctxt tmenvinner) tmenvinner (tcd.entity_typars.Force(tcd.entity_range)) tcdR.entity_typars <- LazyWithContext.NotLazy tpsR - tcdR.entity_attribs <- tcd.entity_attribs |> remapAttribs ctxt tmenvinner2 + tcdR.entity_attribs <- WellKnownEntityAttribs.Create(tcd.entity_attribs.AsList() |> remapAttribs ctxt tmenvinner2) tcdR.entity_tycon_repr <- tcd.entity_tycon_repr |> remapTyconRepr ctxt tmenvinner2 let typeAbbrevR = tcd.TypeAbbrev |> Option.map (remapType tmenvinner2) tcdR.entity_tycon_tcaug <- tcd.entity_tycon_tcaug |> remapTyconAug tmenvinner2 @@ -10064,7 +10147,7 @@ let MakeExportRemapping viewedCcu (mspec: ModuleOrNamespace) = let rec remapEntityDataToNonLocal ctxt tmenv (d: Entity) = let tpsR, tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs ctxt tmenv) tmenv (d.entity_typars.Force(d.entity_range)) let typarsR = LazyWithContext.NotLazy tpsR - let attribsR = d.entity_attribs |> remapAttribs ctxt tmenvinner + let attribsR = d.entity_attribs.AsList() |> remapAttribs ctxt tmenvinner let tyconReprR = d.entity_tycon_repr |> remapTyconRepr ctxt tmenvinner let tyconAbbrevR = d.TypeAbbrev |> Option.map (remapType tmenvinner) let tyconTcaugR = d.entity_tycon_tcaug |> remapTyconAug tmenvinner @@ -10074,7 +10157,7 @@ let rec remapEntityDataToNonLocal ctxt tmenv (d: Entity) = let exnInfoR = d.ExceptionInfo |> remapTyconExnInfo ctxt tmenvinner { d with entity_typars = typarsR - entity_attribs = attribsR + entity_attribs = WellKnownEntityAttribs.Create(attribsR) entity_tycon_repr = tyconReprR entity_tycon_tcaug = tyconTcaugR entity_modul_type = modulContentsR @@ -11553,7 +11636,7 @@ let CombineCcuContentFragments l = entity1 |> Construct.NewModifiedTycon (fun data1 -> let xml = XmlDoc.Merge entity1.XmlDoc entity2.XmlDoc { data1 with - entity_attribs = entity1.Attribs @ entity2.Attribs + entity_attribs = WellKnownEntityAttribs.Create(entity1.Attribs @ entity2.Attribs) entity_modul_type = MaybeLazy.Lazy (InterruptibleLazy(fun _ -> CombineModuleOrNamespaceTypes path2 entity1.ModuleOrNamespaceType entity2.ModuleOrNamespaceType)) entity_opt_data = match data1.entity_opt_data with @@ -11911,7 +11994,7 @@ let tryAddExtensionAttributeIfNotAlreadyPresentForModule match tryFindExtensionAttributeIn (tryFindExtensionAttribute g) with | None -> moduleEntity | Some extensionAttrib -> - { moduleEntity with entity_attribs = extensionAttrib :: moduleEntity.Attribs } + { moduleEntity with entity_attribs = WellKnownEntityAttribs.Create(extensionAttrib :: moduleEntity.Attribs) } let tryAddExtensionAttributeIfNotAlreadyPresentForType (g: TcGlobals) @@ -11928,7 +12011,7 @@ let tryAddExtensionAttributeIfNotAlreadyPresentForType | Some extensionAttrib -> moduleOrNamespaceTypeAccumulator.Value.AllEntitiesByLogicalMangledName.TryFind(typeEntity.LogicalName) |> Option.iter (fun e -> - e.entity_attribs <- extensionAttrib :: e.Attribs + e.entity_attribs <- WellKnownEntityAttribs.Create(extensionAttrib :: e.Attribs) ) typeEntity diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index d28c20003a7..13f0a860095 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2393,6 +2393,12 @@ type ILFieldDef with member HasWellKnownAttribute: g: TcGlobals * flag: WellKnownILAttributes -> bool +/// Compute well-known attribute flags for an Entity's Attrib list. +val computeEntityWellKnownFlags: g: TcGlobals -> attribs: Attribs -> WellKnownEntityAttributes + +/// Check if an Entity has a specific well-known attribute, computing and caching flags if needed. +val EntityHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownEntityAttributes -> entity: Entity -> bool + val IsMatchingFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attrib -> bool val IsMatchingFSharpAttributeOpt: TcGlobals -> BuiltinAttribInfo option -> Attrib -> bool diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index b5bd769de7f..a94982d47c9 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -2799,7 +2799,7 @@ and p_entity_spec_data (x: Entity) st = p_option p_pubpath x.entity_pubpath st p_access x.Accessibility st p_access x.TypeReprAccessibility st - p_attribs x.entity_attribs st + p_attribs (x.entity_attribs.AsList()) st let flagBit = p_tycon_repr x.entity_tycon_repr st p_option p_ty x.TypeAbbrev st p_tcaug x.entity_tycon_tcaug st @@ -3145,7 +3145,7 @@ and u_entity_spec_data st : Entity = entity_logical_name = x2a entity_range = x2c entity_pubpath = x3 - entity_attribs = x6 + entity_attribs = WellKnownEntityAttribs.Create(x6) entity_tycon_repr = x7 entity_tycon_tcaug = x9 entity_flags = EntityFlags x11 From 9e52b7254d26a463f3bed54f355b78826bcdaf3c Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Sat, 21 Feb 2026 00:17:47 +0100 Subject: [PATCH 05/71] Migrate 30 entity-level existence checks to EntityHasWellKnownAttribute Replace O(N) HasFSharpAttribute calls with O(1) EntityHasWellKnownAttribute bit tests for entity-level existence-only attribute checks across: - AugmentWithHashCompare.fs (1 site) - CheckDeclarations.fs (12 sites) - ConstraintSolver.fs (4 sites) - CheckExpressions.fs (1 site) - NameResolution.fs (9 sites) - PostInferenceChecks.fs (2 sites) - IlxGen.fs (2 sites) Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../Checking/AugmentWithHashCompare.fs | 2 +- src/Compiler/Checking/CheckDeclarations.fs | 22 +++++++++---------- src/Compiler/Checking/ConstraintSolver.fs | 8 +++---- .../Checking/Expressions/CheckExpressions.fs | 2 +- src/Compiler/Checking/NameResolution.fs | 18 +++++++-------- src/Compiler/Checking/PostInferenceChecks.fs | 4 ++-- src/Compiler/CodeGen/IlxGen.fs | 4 ++-- 7 files changed, 30 insertions(+), 30 deletions(-) diff --git a/src/Compiler/Checking/AugmentWithHashCompare.fs b/src/Compiler/Checking/AugmentWithHashCompare.fs index f24d23f5f98..1af54769655 100644 --- a/src/Compiler/Checking/AugmentWithHashCompare.fs +++ b/src/Compiler/Checking/AugmentWithHashCompare.fs @@ -1645,7 +1645,7 @@ let rec TypeDefinitelyHasEquality g ty = let appTy = tryAppTy g ty match appTy with - | ValueSome(tcref, _) when HasFSharpAttribute g g.attrib_NoEqualityAttribute tcref.Attribs -> false + | ValueSome(tcref, _) when EntityHasWellKnownAttribute g WellKnownEntityAttributes.NoEqualityAttribute tcref.Deref -> false | _ -> if ty |> IsTyparTyWithConstraint g _.IsSupportsEquality then true diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 4d749700358..a46be9dd187 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -730,11 +730,11 @@ let TcOpenModuleOrNamespaceDecl tcSink g amap scopem env (longId, m) = // Allow "open Foo" for "Microsoft.Foo" from FSharp.Core modrefs |> List.iter (fun (_, modref, _) -> - if modref.IsModule && HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute modref.Attribs then + if modref.IsModule && EntityHasWellKnownAttribute g WellKnownEntityAttributes.RequireQualifiedAccessAttribute modref.Deref then errorR(Error(FSComp.SR.tcModuleRequiresQualifiedAccess(fullDisplayTextOfModRef modref), m))) // Bug FSharp 1.0 3133: 'open Lexing'. Skip this warning if we successfully resolved to at least a module name - if not (modrefs |> List.exists (fun (_, modref, _) -> modref.IsModule && not (HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute modref.Attribs))) then + if not (modrefs |> List.exists (fun (_, modref, _) -> modref.IsModule && not (EntityHasWellKnownAttribute g WellKnownEntityAttributes.RequireQualifiedAccessAttribute modref.Deref))) then modrefs |> List.iter (fun (_, modref, _) -> if IsPartiallyQualifiedNamespace modref then errorR(Error(FSComp.SR.tcOpenUsedWithPartiallyQualifiedPath(fullDisplayTextOfModRef modref), m))) @@ -2085,7 +2085,7 @@ let TcMutRecDefns_Phase2 (cenv: cenv) envInitial mBinds scopem mutRecNSInfo (env let (MutRecDefnsPhase2DataForTycon(tyconOpt, _x, declKind, tcref, _, _, declaredTyconTypars, synMembers, _, _, fixupFinalAttrs)) = tyconData // If a tye uses both [] and [] attributes it means it is a static class. - let isStaticClass = HasFSharpAttribute g g.attrib_SealedAttribute tcref.Attribs && HasFSharpAttribute g g.attrib_AbstractClassAttribute tcref.Attribs + let isStaticClass = EntityHasWellKnownAttribute g WellKnownEntityAttributes.SealedAttribute tcref.Deref && EntityHasWellKnownAttribute g WellKnownEntityAttributes.AbstractClassAttribute tcref.Deref if isStaticClass && g.langVersion.SupportsFeature(LanguageFeature.ErrorReportingOnStaticClasses) then ReportErrorOnStaticClass synMembers match tyconOpt with @@ -2175,7 +2175,7 @@ module TyconConstraintInference = ExistsSameHeadTypeInHierarchy g cenv.amap range0 ty g.mk_IStructuralComparable_ty) && // Check it isn't ruled out by the user - not (HasFSharpAttribute g g.attrib_NoComparisonAttribute tcref.Attribs) + not (EntityHasWellKnownAttribute g WellKnownEntityAttributes.NoComparisonAttribute tcref.Deref) && // Check the structural dependencies (tinst, tcref.TyparsNoRange) ||> List.lengthsEqAndForall2 (fun ty tp -> @@ -2192,8 +2192,8 @@ module TyconConstraintInference = if cenv.g.compilingFSharpCore && AugmentTypeDefinitions.TyconIsCandidateForAugmentationWithCompare g tycon && - not (HasFSharpAttribute g g.attrib_StructuralComparisonAttribute tycon.Attribs) && - not (HasFSharpAttribute g g.attrib_NoComparisonAttribute tycon.Attribs) then + not (EntityHasWellKnownAttribute g WellKnownEntityAttributes.StructuralComparisonAttribute tycon) && + not (EntityHasWellKnownAttribute g WellKnownEntityAttributes.NoComparisonAttribute tycon) then errorR(Error(FSComp.SR.tcFSharpCoreRequiresExplicit(), tycon.Range)) let res = (structuralTypes |> List.forall (fst >> checkIfFieldTypeSupportsComparison tycon)) @@ -2299,7 +2299,7 @@ module TyconConstraintInference = true) && // Check it isn't ruled out by the user - not (HasFSharpAttribute g g.attrib_NoEqualityAttribute tcref.Attribs) + not (EntityHasWellKnownAttribute g WellKnownEntityAttributes.NoEqualityAttribute tcref.Deref) && // Check the structural dependencies (tinst, tcref.TyparsNoRange) ||> List.lengthsEqAndForall2 (fun ty tp -> @@ -2317,8 +2317,8 @@ module TyconConstraintInference = if cenv.g.compilingFSharpCore && AugmentTypeDefinitions.TyconIsCandidateForAugmentationWithEquals g tycon && - not (HasFSharpAttribute g g.attrib_StructuralEqualityAttribute tycon.Attribs) && - not (HasFSharpAttribute g g.attrib_NoEqualityAttribute tycon.Attribs) then + not (EntityHasWellKnownAttribute g WellKnownEntityAttributes.StructuralEqualityAttribute tycon) && + not (EntityHasWellKnownAttribute g WellKnownEntityAttributes.NoEqualityAttribute tycon) then errorR(Error(FSComp.SR.tcFSharpCoreRequiresExplicit(), tycon.Range)) // Remove structural types with incomparable elements from the assumedTycons @@ -3544,7 +3544,7 @@ module EstablishTypeDefinitionCores = structLayoutAttributeCheck false noAllowNullLiteralAttributeCheck() - let hasRQAAttribute = HasFSharpAttribute cenv.g cenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs + let hasRQAAttribute = EntityHasWellKnownAttribute cenv.g WellKnownEntityAttributes.RequireQualifiedAccessAttribute tycon TcRecdUnionAndEnumDeclarations.CheckUnionCaseName cenv unionCaseName hasRQAAttribute let unionCase = Construct.NewUnionCase unionCaseName [] thisTy [] XmlDoc.Empty tycon.Accessibility writeFakeUnionCtorsToSink [ unionCase ] @@ -3576,7 +3576,7 @@ module EstablishTypeDefinitionCores = noAllowNullLiteralAttributeCheck() structLayoutAttributeCheck false - let hasRQAAttribute = HasFSharpAttribute cenv.g cenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs + let hasRQAAttribute = EntityHasWellKnownAttribute cenv.g WellKnownEntityAttributes.RequireQualifiedAccessAttribute tycon let unionCases = TcRecdUnionAndEnumDeclarations.TcUnionCaseDecls cenv envinner innerParent thisTy thisTyInst hasRQAAttribute tpenv unionCases multiCaseUnionStructCheck unionCases diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index c6df0d4dd0e..8a567e0ecef 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -2818,7 +2818,7 @@ and SolveTypeSupportsComparison (csenv: ConstraintSolverEnv) ndeep m2 trace ty = | ValueNone -> // Check it isn't ruled out by the user match tryTcrefOfAppTy g ty with - | ValueSome tcref when HasFSharpAttribute g g.attrib_NoComparisonAttribute tcref.Attribs -> + | ValueSome tcref when EntityHasWellKnownAttribute g WellKnownEntityAttributes.NoComparisonAttribute tcref.Deref -> ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison1(NicePrint.minimalStringOfType denv ty), m, m2)) | _ -> match ty with @@ -2861,7 +2861,7 @@ and SolveTypeSupportsEquality (csenv: ConstraintSolverEnv) ndeep m2 trace ty = AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.SupportsEquality m) | _ -> match tryTcrefOfAppTy g ty with - | ValueSome tcref when HasFSharpAttribute g g.attrib_NoEqualityAttribute tcref.Attribs -> + | ValueSome tcref when EntityHasWellKnownAttribute g WellKnownEntityAttributes.NoEqualityAttribute tcref.Deref -> ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality1(NicePrint.minimalStringOfType denv ty), m, m2)) | _ -> match ty with @@ -3019,7 +3019,7 @@ and SolveTypeRequiresDefaultConstructor (csenv: ConstraintSolverEnv) ndeep m2 tr |> List.exists (fun x -> x.IsNullary && IsMethInfoAccessible amap m AccessibleFromEverywhere x) then match tryTcrefOfAppTy g ty with - | ValueSome tcref when HasFSharpAttribute g g.attrib_AbstractClassAttribute tcref.Attribs -> + | ValueSome tcref when EntityHasWellKnownAttribute g WellKnownEntityAttributes.AbstractClassAttribute tcref.Deref -> ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresNonAbstract(NicePrint.minimalStringOfType denv origTy), m, m2)) | _ -> CompleteD @@ -3028,7 +3028,7 @@ and SolveTypeRequiresDefaultConstructor (csenv: ConstraintSolverEnv) ndeep m2 tr | ValueSome tcref when tcref.PreEstablishedHasDefaultConstructor || // F# 3.1 feature: records with CLIMutable attribute should satisfy 'default constructor' constraint - (tcref.IsRecordTycon && HasFSharpAttribute g g.attrib_CLIMutableAttribute tcref.Attribs) -> + (tcref.IsRecordTycon && EntityHasWellKnownAttribute g WellKnownEntityAttributes.CLIMutableAttribute tcref.Deref) -> CompleteD | _ -> ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresPublicDefaultConstructor(NicePrint.minimalStringOfType denv origTy), m, m2)) diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 6f129bdc828..b75494ea93b 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -7274,7 +7274,7 @@ and TcObjectExpr (cenv: cenv) env tpenv (objTy, realObjTy, argopt, binds, extraI let isRecordTy = tcref.IsRecordTycon let isInterfaceTy = isInterfaceTy g objTy let isFSharpObjModelTy = isFSharpObjModelTy g objTy - let isOverallTyAbstract = HasFSharpAttribute g g.attrib_AbstractClassAttribute tcref.Attribs || isAbstractTycon tcref.Deref + let isOverallTyAbstract = EntityHasWellKnownAttribute g WellKnownEntityAttributes.AbstractClassAttribute tcref.Deref || isAbstractTycon tcref.Deref if not isRecordTy && not isInterfaceTy && isSealedTy g objTy then errorR(Error(FSComp.SR.tcCannotCreateExtensionOfSealedType(), mNewExpr)) diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 9d34ae76221..21372737c12 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -1267,7 +1267,7 @@ and private AddStaticPartsOfTyconRefToNameEnv bulkAddMode ownDefinition g amap m | Choice1Of2 (tcref, extMemInfo) -> tab1.Add (tcref, extMemInfo), tab2 | Choice2Of2 extMemInfo -> tab1, extMemInfo :: tab2) - let isILOrRequiredQualifiedAccess = isIL || (not ownDefinition && HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute tcref.Attribs) + let isILOrRequiredQualifiedAccess = isIL || (not ownDefinition && EntityHasWellKnownAttribute g WellKnownEntityAttributes.RequireQualifiedAccessAttribute tcref.Deref) // Record labels let eFieldLabels = @@ -2969,7 +2969,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv (type | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> let ucref = mkUnionCaseRef (modref.NestedTyconRef tycon) id.idText let ucinfo = FreshenUnionCaseRef ncenv m ucref - let hasRequireQualifiedAccessAttribute = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs + let hasRequireQualifiedAccessAttribute = EntityHasWellKnownAttribute ncenv.g WellKnownEntityAttributes.RequireQualifiedAccessAttribute tycon success [resInfo, Item.UnionCase(ucinfo, hasRequireQualifiedAccessAttribute), rest], hasRequireQualifiedAccessAttribute | _ -> NoResultsOrUsefulErrors, false @@ -3030,7 +3030,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv (type addToBuffer e.DisplayName if e.IsUnionTycon then - let hasRequireQualifiedAccessAttribute = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute e.Attribs + let hasRequireQualifiedAccessAttribute = EntityHasWellKnownAttribute ncenv.g WellKnownEntityAttributes.RequireQualifiedAccessAttribute e if not hasRequireQualifiedAccessAttribute then for uc in e.UnionCasesArray do addToBuffer uc.DisplayName @@ -3211,7 +3211,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified // check if the user forgot to use qualified access for e in nenv.eTyconsByDemangledNameAndArity do - let hasRequireQualifiedAccessAttribute = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute e.Value.Attribs + let hasRequireQualifiedAccessAttribute = EntityHasWellKnownAttribute ncenv.g WellKnownEntityAttributes.RequireQualifiedAccessAttribute e.Value.Deref if hasRequireQualifiedAccessAttribute then if e.Value.IsUnionTycon && e.Value.UnionCasesArray |> Array.exists (fun c -> c.LogicalName = id.idText) then addToBuffer (e.Value.DisplayName + "." + id.idText) @@ -3329,7 +3329,7 @@ let rec ResolvePatternLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv nu | Some tycon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> let tcref = modref.NestedTyconRef tycon let ucref = mkUnionCaseRef tcref id.idText - let showDeprecated = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs + let showDeprecated = EntityHasWellKnownAttribute ncenv.g WellKnownEntityAttributes.RequireQualifiedAccessAttribute tycon let ucinfo = FreshenUnionCaseRef ncenv m ucref success (resInfo, Item.UnionCase(ucinfo, showDeprecated), rest) | _ -> @@ -3756,7 +3756,7 @@ let rec ResolveFieldInModuleOrNamespace (ncenv: NameResolver) nenv ad (resInfo: let modulScopedFieldNames = match TryFindTypeWithRecdField modref id with | Some tycon when IsEntityAccessible ncenv.amap m ad (modref.NestedTyconRef tycon) -> - let showDeprecated = HasFSharpAttribute ncenv.g ncenv.g.attrib_RequireQualifiedAccessAttribute tycon.Attribs + let showDeprecated = EntityHasWellKnownAttribute ncenv.g WellKnownEntityAttributes.RequireQualifiedAccessAttribute tycon success [resInfo, FieldResolution(FreshenRecdFieldRef ncenv m (modref.RecdFieldRefInNestedTycon tycon id), showDeprecated), rest] | _ -> raze (UndefinedName(depth, FSComp.SR.undefinedNameRecordLabelOrNamespace, id, NoSuggestions)) @@ -3839,7 +3839,7 @@ let SuggestLabelsOfRelatedRecords g (nenv: NameResolutionEnv) (id: Ident) (allFi else // check if the user forgot to use qualified access for e in nenv.eTyconsByDemangledNameAndArity do - let hasRequireQualifiedAccessAttribute = HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute e.Value.Attribs + let hasRequireQualifiedAccessAttribute = EntityHasWellKnownAttribute g WellKnownEntityAttributes.RequireQualifiedAccessAttribute e.Value.Deref if hasRequireQualifiedAccessAttribute then if e.Value.IsRecordTycon && e.Value.AllFieldsArray |> Seq.exists (fun x -> x.LogicalName = id.idText) then addToBuffer (e.Value.DisplayName + "." + id.idText) @@ -4788,7 +4788,7 @@ let rec ResolvePartialLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv is // Collect up the accessible discriminated union cases in the module @ (UnionCaseRefsInModuleOrNamespace modref |> List.filter (IsUnionCaseUnseen ad g ncenv.amap m allowObsolete >> not) - |> List.filter (fun ucref -> not (HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute ucref.TyconRef.Attribs)) + |> List.filter (fun ucref -> not (EntityHasWellKnownAttribute g WellKnownEntityAttributes.RequireQualifiedAccessAttribute ucref.TyconRef.Deref)) |> List.map (fun x -> Item.UnionCase(GeneralizeUnionCaseRef x, false))) // Collect up the accessible active patterns in the module @@ -5351,7 +5351,7 @@ let rec ResolvePartialLongIdentInModuleOrNamespaceForItem (ncenv: NameResolver) yield! UnionCaseRefsInModuleOrNamespace modref |> List.filter (IsUnionCaseUnseen ad g ncenv.amap m false >> not) - |> List.filter (fun ucref -> not (HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute ucref.TyconRef.Attribs)) + |> List.filter (fun ucref -> not (EntityHasWellKnownAttribute g WellKnownEntityAttributes.RequireQualifiedAccessAttribute ucref.TyconRef.Deref)) |> List.map (fun x -> Item.UnionCase(GeneralizeUnionCaseRef x, false)) | Item.ActivePatternCase _ -> diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 16b29b71ab6..0c62eb566ba 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -2123,7 +2123,7 @@ and CheckBinding cenv env alwaysCheckNoReraise ctxt (TBind(v, bindRhs, _) as bin // Also check the enclosing type for members - for historical reasons, in the TAST member values // are stored in the entity that encloses the type, hence we will not have noticed the ReflectedDefinition // on the enclosing type at this point. - HasFSharpAttribute g g.attrib_ReflectedDefinitionAttribute v.DeclaringEntity.Attribs) then + EntityHasWellKnownAttribute g WellKnownEntityAttributes.ReflectedDefinitionAttribute v.DeclaringEntity.Deref) then if v.IsInstanceMember && v.MemberApparentEntity.IsStructOrEnumTycon then errorR(Error(FSComp.SR.chkNoReflectedDefinitionOnStructMember(), v.Range)) @@ -2347,7 +2347,7 @@ let CheckEntityDefn cenv env (tycon: Entity) = let tcref = mkLocalTyconRef tycon let ty = generalizedTyconRef g tcref - let env = { env with reflect = env.reflect || HasFSharpAttribute g g.attrib_ReflectedDefinitionAttribute tycon.Attribs } + let env = { env with reflect = env.reflect || EntityHasWellKnownAttribute g WellKnownEntityAttributes.ReflectedDefinitionAttribute tycon } let env = BindTypars g env (tycon.Typars m) CheckAttribs cenv env tycon.Attribs diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 9231fa10c26..db78b9b23ff 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -8433,7 +8433,7 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv bind isStateVar startMarkOpt = initLocals = eenv.initLocals && (match vspec.ApparentEnclosingEntity with - | Parent ref -> not (HasFSharpAttribute g g.attrib_SkipLocalsInitAttribute ref.Attribs) + | Parent ref -> not (EntityHasWellKnownAttribute g WellKnownEntityAttributes.SkipLocalsInitAttribute ref.Deref) | _ -> true) } @@ -11023,7 +11023,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option let generateDebugProxies = not (tyconRefEq g tcref g.unit_tcr_canon) - && not (HasFSharpAttribute g g.attrib_DebuggerTypeProxyAttribute tycon.Attribs) + && not (EntityHasWellKnownAttribute g WellKnownEntityAttributes.DebuggerTypeProxyAttribute tycon) let permissionSets = CreatePermissionSets cenv eenv securityAttrs From 15662460b86d48e4450e55352a4c2cdd87984bf5 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Sat, 21 Feb 2026 01:29:51 +0100 Subject: [PATCH 06/71] Sprint 4: Val Container And Infrastructure - WellKnownValAttribs - Add WellKnownValAttributes flags enum (25 flags + NotComputed sentinel) - Add WellKnownValAttribs wrapper struct mirroring WellKnownEntityAttribs - Change ValOptionalData.val_attribs field type to WellKnownValAttribs - Add Val.ValAttribs property returning WellKnownValAttribs - Add Val.SetValAttribs accepting WellKnownValAttribs - Val.Attribs still returns Attrib list, Val.SetAttribs still accepts Attribs - Change ArgReprInfo.Attribs field type to WellKnownValAttribs - Add computeValWellKnownFlags covering all 25 enum flags - Add ValHasWellKnownAttribute helper in TypedTreeOps - Update TypedTreePickle for val_attribs and ArgReprInfo serialization - Fix all downstream usage sites across compiler Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/CheckDeclarations.fs | 6 +- .../CheckComputationExpressions.fs | 2 +- .../Checking/Expressions/CheckExpressions.fs | 6 +- src/Compiler/Checking/FindUnsolved.fs | 2 +- src/Compiler/Checking/NicePrint.fs | 8 +- src/Compiler/Checking/PostInferenceChecks.fs | 2 +- src/Compiler/Checking/SignatureConformance.fs | 12 +-- src/Compiler/Checking/infos.fs | 25 ++--- src/Compiler/CodeGen/IlxGen.fs | 4 +- src/Compiler/Driver/CompilerDiagnostics.fs | 2 +- src/Compiler/Interactive/fsi.fs | 2 +- src/Compiler/Symbols/SymbolHelpers.fs | 2 +- src/Compiler/Symbols/Symbols.fs | 18 ++-- src/Compiler/TypedTree/TypedTree.fs | 100 ++++++++++++++++-- src/Compiler/TypedTree/TypedTree.fsi | 55 +++++++++- src/Compiler/TypedTree/TypedTreeBasics.fs | 8 +- src/Compiler/TypedTree/TypedTreeOps.fs | 98 ++++++++++++++++- src/Compiler/TypedTree/TypedTreeOps.fsi | 5 + src/Compiler/TypedTree/TypedTreePickle.fs | 6 +- src/Compiler/Utilities/TypeHashing.fs | 2 +- 20 files changed, 300 insertions(+), 65 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index a46be9dd187..2066fe3338a 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -3720,11 +3720,11 @@ module EstablishTypeDefinitionCores = // and needs wrapping to int option. // Explicit [] path: string option already has wrapped type. let ty = - if HasFSharpAttribute g g.attrib_OptionalArgumentAttribute argInfo.Attribs then + if HasFSharpAttribute g g.attrib_OptionalArgumentAttribute (argInfo.Attribs.AsList()) then if isOptionTy g ty || isValueOptionTy g ty then ty else - match TryFindFSharpAttribute g g.attrib_StructAttribute argInfo.Attribs with + match TryFindFSharpAttribute g g.attrib_StructAttribute (argInfo.Attribs.AsList()) with | Some (Attrib(range=m)) -> checkLanguageFeatureAndRecover g.langVersion LanguageFeature.SupportValueOptionsAsOptionalParameters m mkValueOptionTy g ty @@ -3735,7 +3735,7 @@ module EstablishTypeDefinitionCores = // Extract parameter attributes including optional and caller info flags // This ensures delegates have proper metadata for optional parameters let (ParamAttribs(_, isInArg, isOutArg, optArgInfo, _, _)) = CrackParamAttribsInfo g (ty, argInfo) - TSlotParam(Option.map textOfId argInfo.Name, ty, isInArg, isOutArg, optArgInfo.IsOptional, argInfo.Attribs)) + TSlotParam(Option.map textOfId argInfo.Name, ty, isInArg, isOutArg, optArgInfo.IsOptional, argInfo.Attribs.AsList())) TFSharpDelegate (MakeSlotSig("Invoke", thisTy, ttps, [], [fparams], returnTy)) | _ -> error(InternalError("should have inferred tycon kind", m)) diff --git a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs index 0af55834f8f..baf331d2f3a 100644 --- a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs @@ -580,7 +580,7 @@ let isCustomOperationProjectionParameter ceenv i (nm: Ident) = | Some argInfos -> i < argInfos.Length && let _, argInfo = List.item i argInfos in - HasFSharpAttribute ceenv.cenv.g ceenv.cenv.g.attrib_ProjectionParameterAttribute argInfo.Attribs) + HasFSharpAttribute ceenv.cenv.g ceenv.cenv.g.attrib_ProjectionParameterAttribute (argInfo.Attribs.AsList())) if List.allEqual vs then vs[0] diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index b75494ea93b..13d563b29ed 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -1005,14 +1005,14 @@ let TranslateTopArgSynInfo (cenv: cenv) isArg m tcAttributes (SynArgInfo(Attribu if found then Some info else None) - |> Option.defaultValue ({ Attribs = attribs; Name = nm; OtherRange = None }: ArgReprInfo) + |> Option.defaultValue ({ Attribs = WellKnownValAttribs.Create(attribs); Name = nm; OtherRange = None }: ArgReprInfo) match key with | Some k -> cenv.argInfoCache.[k] <- argInfo | None -> () // Set freshly computed attribs in case they are different in the cache - argInfo.Attribs <- attribs + argInfo.Attribs <- WellKnownValAttribs.Create(attribs) argInfo @@ -6545,7 +6545,7 @@ and TcIteratedLambdas (cenv: cenv) isFirst (env: TcEnv) overallTy takenNames tpe if infos.Length = vspecs.Length then (vspecs, infos) ||> List.iter2 (fun v argInfo -> v.SetArgReprInfoForDisplay (Some argInfo) - let inlineIfLambda = HasFSharpAttribute g g.attrib_InlineIfLambdaAttribute argInfo.Attribs + let inlineIfLambda = HasFSharpAttribute g g.attrib_InlineIfLambdaAttribute (argInfo.Attribs.AsList()) if inlineIfLambda then v.SetInlineIfLambda()) { envinner with eLambdaArgInfos = rest } diff --git a/src/Compiler/Checking/FindUnsolved.fs b/src/Compiler/Checking/FindUnsolved.fs index c1de629a07c..675cc5b7fd4 100644 --- a/src/Compiler/Checking/FindUnsolved.fs +++ b/src/Compiler/Checking/FindUnsolved.fs @@ -243,7 +243,7 @@ and accValReprInfo cenv env (ValReprInfo(_, args, ret)) = /// Walk an argument representation info, collecting type variables and accArgReprInfo cenv env (argInfo: ArgReprInfo) = - accAttribs cenv env argInfo.Attribs + accAttribs cenv env (argInfo.Attribs.AsList()) /// Walk a value, collecting type variables and accVal cenv env v = diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index 12b7566db6e..5aad7d370d4 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -1084,14 +1084,14 @@ module PrintTypes = let g = denv.g // Detect an optional argument - let isOptionalArg = HasFSharpAttribute g g.attrib_OptionalArgumentAttribute argInfo.Attribs + let isOptionalArg = HasFSharpAttribute g g.attrib_OptionalArgumentAttribute (argInfo.Attribs.AsList()) match argInfo.Name, isOptionalArg, tryDestOptionTy g ty with // Layout an optional argument | Some id, true, ValueSome ty -> let idL = ConvertValLogicalNameToDisplayLayout false (tagParameter >> rightL) id.idText let attrsLayout = - argInfo.Attribs + argInfo.Attribs.AsList() |> List.filter (fun a -> not (IsMatchingFSharpAttribute g g.attrib_OptionalArgumentAttribute a)) |> layoutAttribsOneline denv @@ -1113,7 +1113,7 @@ module PrintTypes = // Layout a named argument | Some id, _, _ -> let idL = ConvertValLogicalNameToDisplayLayout false (tagParameter >> wordL) id.idText - let prefix = layoutAttribsOneline denv argInfo.Attribs ^^ idL + let prefix = layoutAttribsOneline denv (argInfo.Attribs.AsList()) ^^ idL (prefix |> addColonL) ^^ layoutTypeWithInfoAndPrec denv env 2 ty let layoutCurriedArgInfos denv env argInfos = @@ -1363,7 +1363,7 @@ module PrintTastMemberOrVals = if short then for argInfo in argInfos do for _,info in argInfo do - info.Attribs <- [] + info.Attribs <- WellKnownValAttribs.Create([]) info.Name <- None let supportAccessModifiersBeforeGetSet = denv.g.langVersion.SupportsFeature Features.LanguageFeature.AllowAccessModifiersToAutoPropertiesGettersAndSetters diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 0c62eb566ba..92693c64443 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -2050,7 +2050,7 @@ and CheckValInfo cenv env (ValReprInfo(_, args, ret)) = ret |> CheckArgInfo cenv env and CheckArgInfo cenv env (argInfo : ArgReprInfo) = - CheckAttribs cenv env argInfo.Attribs + CheckAttribs cenv env (argInfo.Attribs.AsList()) and CheckValSpecAux permitByRefLike cenv env (v: Val) onInnerByrefError = v.Attribs |> CheckAttribs cenv env diff --git a/src/Compiler/Checking/SignatureConformance.fs b/src/Compiler/Checking/SignatureConformance.fs index bc1d5fad2e4..d124d3794c1 100644 --- a/src/Compiler/Checking/SignatureConformance.fs +++ b/src/Compiler/Checking/SignatureConformance.fs @@ -308,14 +308,14 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = // the implementation. This also propagates argument names from signature to implementation let res = (implArgInfos, sigArgInfos) ||> List.forall2 (List.forall2 (fun implArgInfo sigArgInfo -> - checkAttribs aenv implArgInfo.Attribs sigArgInfo.Attribs (fun attribs -> + checkAttribs aenv (implArgInfo.Attribs.AsList()) (sigArgInfo.Attribs.AsList()) (fun attribs -> match implArgInfo.Name, sigArgInfo.Name with | Some iname, Some sname when sname.idText <> iname.idText -> warning(ArgumentsInSigAndImplMismatch(sname, iname)) | _ -> () - let sigHasInlineIfLambda = HasFSharpAttribute g g.attrib_InlineIfLambdaAttribute sigArgInfo.Attribs - let implHasInlineIfLambda = HasFSharpAttribute g g.attrib_InlineIfLambdaAttribute implArgInfo.Attribs + let sigHasInlineIfLambda = HasFSharpAttribute g g.attrib_InlineIfLambdaAttribute (sigArgInfo.Attribs.AsList()) + let implHasInlineIfLambda = HasFSharpAttribute g g.attrib_InlineIfLambdaAttribute (implArgInfo.Attribs.AsList()) let m = match implArgInfo.Name with | Some iname-> iname.idRange @@ -327,11 +327,11 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = sigArgInfo.OtherRange <- implArgInfo.Name |> Option.map (fun ident -> ident.idRange) implArgInfo.Name <- implArgInfo.Name |> Option.orElse sigArgInfo.Name - implArgInfo.Attribs <- attribs))) && + implArgInfo.Attribs <- WellKnownValAttribs.Create(attribs)))) && - checkAttribs aenv implRetInfo.Attribs sigRetInfo.Attribs (fun attribs -> + checkAttribs aenv (implRetInfo.Attribs.AsList()) (sigRetInfo.Attribs.AsList()) (fun attribs -> implRetInfo.Name <- sigRetInfo.Name - implRetInfo.Attribs <- attribs) + implRetInfo.Attribs <- WellKnownValAttribs.Create(attribs)) implVal.SetValReprInfo (Some (ValReprInfo (sigTyparNames, implArgInfos, implRetInfo))) res diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index d00087cfc5d..19a00c60af9 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -93,7 +93,7 @@ let ReparentSlotSigToUseMethodTypars g m ovByMethValRef slotsig = /// Construct the data representing a parameter in the signature of an abstract method slot let MakeSlotParam (ty, argInfo: ArgReprInfo) = - TSlotParam(Option.map textOfId argInfo.Name, ty, false, false, false, argInfo.Attribs) + TSlotParam(Option.map textOfId argInfo.Name, ty, false, false, false, argInfo.Attribs.AsList()) /// Construct the data representing the signature of an abstract method slot let MakeSlotSig (nm, ty, ctps, mtps, paraml, retTy) = @@ -274,20 +274,21 @@ type ParamData = type ParamAttribs = ParamAttribs of isParamArrayArg: bool * isInArg: bool * isOutArg: bool * optArgInfo: OptionalArgInfo * callerInfo: CallerInfo * reflArgInfo: ReflectedArgInfo let CrackParamAttribsInfo g (ty: TType, argInfo: ArgReprInfo) = - let isParamArrayArg = HasFSharpAttribute g g.attrib_ParamArrayAttribute argInfo.Attribs + let attribs = argInfo.Attribs.AsList() + let isParamArrayArg = HasFSharpAttribute g g.attrib_ParamArrayAttribute attribs let reflArgInfo = - match TryFindFSharpBoolAttributeAssumeFalse g g.attrib_ReflectedDefinitionAttribute argInfo.Attribs with + match TryFindFSharpBoolAttributeAssumeFalse g g.attrib_ReflectedDefinitionAttribute attribs with | Some b -> ReflectedArgInfo.Quote b | None -> ReflectedArgInfo.None - let isOutArg = (HasFSharpAttribute g g.attrib_OutAttribute argInfo.Attribs && isByrefTy g ty) || isOutByrefTy g ty - let isInArg = (HasFSharpAttribute g g.attrib_InAttribute argInfo.Attribs && isByrefTy g ty) || isInByrefTy g ty - let isCalleeSideOptArg = HasFSharpAttribute g g.attrib_OptionalArgumentAttribute argInfo.Attribs - let isCallerSideOptArg = HasFSharpAttributeOpt g g.attrib_OptionalAttribute argInfo.Attribs + let isOutArg = (HasFSharpAttribute g g.attrib_OutAttribute attribs && isByrefTy g ty) || isOutByrefTy g ty + let isInArg = (HasFSharpAttribute g g.attrib_InAttribute attribs && isByrefTy g ty) || isInByrefTy g ty + let isCalleeSideOptArg = HasFSharpAttribute g g.attrib_OptionalArgumentAttribute attribs + let isCallerSideOptArg = HasFSharpAttributeOpt g g.attrib_OptionalAttribute attribs let optArgInfo = if isCalleeSideOptArg then CalleeSide elif isCallerSideOptArg then - let defaultParameterValueAttribute = TryFindFSharpAttributeOpt g g.attrib_DefaultParameterValueAttribute argInfo.Attribs + let defaultParameterValueAttribute = TryFindFSharpAttributeOpt g g.attrib_DefaultParameterValueAttribute attribs match defaultParameterValueAttribute with | None -> // Do a type-directed analysis of the type to determine the default value to pass. @@ -310,9 +311,9 @@ let CrackParamAttribsInfo g (ty: TType, argInfo: ArgReprInfo) = NotOptional else NotOptional - let isCallerLineNumberArg = HasFSharpAttribute g g.attrib_CallerLineNumberAttribute argInfo.Attribs - let isCallerFilePathArg = HasFSharpAttribute g g.attrib_CallerFilePathAttribute argInfo.Attribs - let isCallerMemberNameArg = HasFSharpAttribute g g.attrib_CallerMemberNameAttribute argInfo.Attribs + let isCallerLineNumberArg = HasFSharpAttribute g g.attrib_CallerLineNumberAttribute attribs + let isCallerFilePathArg = HasFSharpAttribute g g.attrib_CallerFilePathAttribute attribs + let isCallerMemberNameArg = HasFSharpAttribute g g.attrib_CallerMemberNameAttribute attribs let callerInfo = match isCallerLineNumberArg, isCallerFilePathArg, isCallerMemberNameArg with @@ -321,7 +322,7 @@ let CrackParamAttribsInfo g (ty: TType, argInfo: ArgReprInfo) = | false, true, false -> CallerFilePath | false, false, true -> CallerMemberName | false, true, true -> - match TryFindFSharpAttribute g g.attrib_CallerMemberNameAttribute argInfo.Attribs with + match TryFindFSharpAttribute g g.attrib_CallerMemberNameAttribute attribs with | Some(Attrib(_, _, _, _, _, _, callerMemberNameAttributeRange)) -> warning(Error(FSComp.SR.CallerMemberNameIsOverridden(argInfo.Name.Value.idText), callerMemberNameAttributeRange)) CallerFilePath diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index db78b9b23ff..49975571e82 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -8996,7 +8996,7 @@ and GenParams (Set.empty, List.zip methArgTys ilArgTysAndInfoAndVals) ||> List.mapFold (fun takenNames (methodArgTy, ((ilArgTy, topArgInfo), implValOpt)) -> let inFlag, outFlag, optionalFlag, defaultParamValue, Marshal, attribs = - GenParamAttribs cenv methodArgTy topArgInfo.Attribs + GenParamAttribs cenv methodArgTy (topArgInfo.Attribs.AsList()) let idOpt = match topArgInfo.Name with @@ -9042,7 +9042,7 @@ and GenParams /// Generate IL method return information and GenReturnInfo cenv eenv returnTy ilRetTy (retInfo: ArgReprInfo) : ILReturn = - let marshal, attribs = GenMarshal cenv retInfo.Attribs + let marshal, attribs = GenMarshal cenv (retInfo.Attribs.AsList()) let ilAttribs = GenAttrs cenv eenv attribs let ilAttribs = diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 1da09301ff5..a7003c29a6e 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -901,7 +901,7 @@ type Exception with tTy, { ArgReprInfo.Name = name |> Option.map (fun name -> Ident(name, range0)) - ArgReprInfo.Attribs = [] + ArgReprInfo.Attribs = WellKnownValAttribs.Create([]) ArgReprInfo.OtherRange = None }) diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 5f4d9295bec..e807af5bf6f 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -1677,7 +1677,7 @@ let internal mkBoundValueTypedImpl tcGlobals m moduleName name ty = [], [], { - Attribs = [] + Attribs = WellKnownValAttribs.Create([]) Name = None OtherRange = None } diff --git a/src/Compiler/Symbols/SymbolHelpers.fs b/src/Compiler/Symbols/SymbolHelpers.fs index fed644eeb61..fceee8269e7 100644 --- a/src/Compiler/Symbols/SymbolHelpers.fs +++ b/src/Compiler/Symbols/SymbolHelpers.fs @@ -238,7 +238,7 @@ module internal SymbolHelpers = // Drop the first 'seq' argument representing the computation space let argInfos = if argInfos.IsEmpty then [] else argInfos.Tail [ for ty, argInfo in argInfos do - let isPP = HasFSharpAttribute g g.attrib_ProjectionParameterAttribute argInfo.Attribs + let isPP = HasFSharpAttribute g g.attrib_ProjectionParameterAttribute (argInfo.Attribs.AsList()) // Strip the tuple space type of the type of projection parameters let ty = if isPP && isFunTy g ty then rangeOfFunTy g ty else ty yield ParamNameAndType(argInfo.Name, ty) ] diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs index d7db3ecd192..ad5b1cf6e06 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -2126,7 +2126,7 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = [ [ for ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, _callerInfo, nmOpt, _reflArgInfo, pty) in p.GetParamDatas(cenv.amap, range0) do // INCOMPLETENESS: Attribs is empty here, so we can't look at attributes for // either .NET or F# parameters - let argInfo: ArgReprInfo = { Name=nmOpt; Attribs=[]; OtherRange=None } + let argInfo: ArgReprInfo = { Name=nmOpt; Attribs=WellKnownValAttribs.Create([]); OtherRange=None } let m = match nmOpt with | Some v -> v.idRange @@ -2145,7 +2145,7 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = [ for ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, _callerInfo, nmOpt, _reflArgInfo, pty) in argTys do // INCOMPLETENESS: Attribs is empty here, so we can't look at attributes for // either .NET or F# parameters - let argInfo: ArgReprInfo = { Name=nmOpt; Attribs=[]; OtherRange=None } + let argInfo: ArgReprInfo = { Name=nmOpt; Attribs=WellKnownValAttribs.Create([]); OtherRange=None } let m = match nmOpt with | Some v -> v.idRange @@ -2181,10 +2181,10 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = [ for argTys in argTysl do yield [ for argTy, argInfo in argTys do - let isParamArrayArg = HasFSharpAttribute cenv.g cenv.g.attrib_ParamArrayAttribute argInfo.Attribs - let isInArg = HasFSharpAttribute cenv.g cenv.g.attrib_InAttribute argInfo.Attribs && isByrefTy cenv.g argTy - let isOutArg = HasFSharpAttribute cenv.g cenv.g.attrib_OutAttribute argInfo.Attribs && isByrefTy cenv.g argTy - let isOptionalArg = HasFSharpAttribute cenv.g cenv.g.attrib_OptionalArgumentAttribute argInfo.Attribs + let isParamArrayArg = HasFSharpAttribute cenv.g cenv.g.attrib_ParamArrayAttribute (argInfo.Attribs.AsList()) + let isInArg = HasFSharpAttribute cenv.g cenv.g.attrib_InAttribute (argInfo.Attribs.AsList()) && isByrefTy cenv.g argTy + let isOutArg = HasFSharpAttribute cenv.g cenv.g.attrib_OutAttribute (argInfo.Attribs.AsList()) && isByrefTy cenv.g argTy + let isOptionalArg = HasFSharpAttribute cenv.g cenv.g.attrib_OptionalArgumentAttribute (argInfo.Attribs.AsList()) let m = match argInfo.Name with | Some v -> v.idRange @@ -2500,7 +2500,7 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = let nm = String.uncapitalize witnessInfo.MemberName let nm = if used.Contains nm then nm + string i else nm let m = x.DeclarationLocation - let argReprInfo : ArgReprInfo = { Attribs=[]; Name=Some (mkSynId m nm); OtherRange=None } + let argReprInfo : ArgReprInfo = { Attribs=WellKnownValAttribs.Create([]); Name=Some (mkSynId m nm); OtherRange=None } let p = FSharpParameter(cenv, paramTy, argReprInfo, None, m, false, false, false, false, true) p, (used.Add nm, i + 1)) |> fst @@ -2884,7 +2884,7 @@ type FSharpParameter(cenv, paramTy: TType, topArgInfo: ArgReprInfo, ownerOpt, m: (fun _ _ _ -> true)) new (cenv, idOpt, ty, ownerOpt, m) = - let argInfo: ArgReprInfo = { Name = idOpt; Attribs = []; OtherRange = None } + let argInfo: ArgReprInfo = { Name = idOpt; Attribs = WellKnownValAttribs.Create([]); OtherRange = None } FSharpParameter(cenv, ty, argInfo, ownerOpt, m, false, false, false, false, false) new (cenv, ty, argInfo: ArgReprInfo, m: range) = @@ -2908,7 +2908,7 @@ type FSharpParameter(cenv, paramTy: TType, topArgInfo: ArgReprInfo, ownerOpt, m: | _ -> None override _.Attributes = - topArgInfo.Attribs |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) |> makeReadOnlyCollection + topArgInfo.Attribs.AsList() |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) |> makeReadOnlyCollection member _.IsParamArrayArg = isParamArrayArg diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index aadee16004f..9f48ee9c8e5 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -2774,7 +2774,7 @@ type ValOptionalData = /// Custom attributes attached to the value. These contain references to other values (i.e. constructors in types). Mutable to fixup /// these value references after copying a collection of values. - mutable val_attribs: Attribs + mutable val_attribs: WellKnownValAttribs } [] @@ -2817,7 +2817,7 @@ type Val = val_member_info = None val_declaring_entity = ParentNone val_xmldocsig = String.Empty - val_attribs = [] } + val_attribs = WellKnownValAttribs.Create([]) } /// Range of the definition (implementation) of the value, used by Visual Studio member x.DefinitionRange = @@ -3051,9 +3051,15 @@ type Val = /// Get the declared attributes for the value member x.Attribs = match x.val_opt_data with - | Some optData -> optData.val_attribs + | Some optData -> optData.val_attribs.AsList() | _ -> [] + /// Get the declared attributes wrapper for the value + member x.ValAttribs = + match x.val_opt_data with + | Some optData -> optData.val_attribs + | _ -> WellKnownValAttribs.Create([]) + /// Get the declared documentation for the value member x.XmlDoc = match x.val_opt_data with @@ -3310,7 +3316,13 @@ type Val = | Some optData -> optData.val_declaring_entity <- parent | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_declaring_entity = parent } - member x.SetAttribs attribs = + member x.SetAttribs (attribs: Attribs) = + let wa = WellKnownValAttribs.Create(attribs) + match x.val_opt_data with + | Some optData -> optData.val_attribs <- wa + | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_attribs = wa } + + member x.SetValAttribs (attribs: WellKnownValAttribs) = match x.val_opt_data with | Some optData -> optData.val_attribs <- attribs | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_attribs = attribs } @@ -4709,6 +4721,82 @@ type WellKnownEntityAttribs = else WellKnownEntityAttribs(x.attribs, WellKnownEntityAttributes.NotComputed) +/// Flags enum for well-known attributes on Val (values and members). +/// Used to avoid O(N) linear scans of attribute lists. +[] +type WellKnownValAttributes = + | None = 0uL + | DllImportAttribute = 0x1uL + | EntryPointAttribute = 0x2uL + | LiteralAttribute = 0x4uL + | ConditionalAttribute = 0x8uL + | ReflectedDefinitionAttribute = 0x10uL + | RequiresExplicitTypeArgumentsAttribute = 0x20uL + | DefaultValueAttribute = 0x40uL + | SkipLocalsInitAttribute = 0x80uL + | ThreadStaticAttribute = 0x100uL + | ContextStaticAttribute = 0x200uL + | VolatileFieldAttribute = 0x400uL + | NoDynamicInvocationAttribute = 0x800uL + | ExtensionAttribute = 0x1000uL + | OptionalArgumentAttribute = 0x2000uL + | InAttribute = 0x4000uL + | OutAttribute = 0x8000uL + | ParamArrayAttribute = 0x10000uL + | CallerMemberNameAttribute = 0x20000uL + | CallerFilePathAttribute = 0x40000uL + | CallerLineNumberAttribute = 0x80000uL + | DefaultParameterValueAttribute = 0x100000uL + | ProjectionParameterAttribute = 0x200000uL + | InlineIfLambdaAttribute = 0x400000uL + | OptionalAttribute = 0x800000uL + | StructAttribute = 0x1000000uL + | NotComputed = 0x8000000000000000uL + +/// Wraps an Attrib list together with cached WellKnownValAttributes flags for O(1) lookup. +[] +type WellKnownValAttribs = + val private attribs: Attrib list + val private flags: WellKnownValAttributes + + new(attribs: Attrib list, flags: WellKnownValAttributes) = { attribs = attribs; flags = flags } + + /// Check if a specific well-known attribute flag is set. + member x.HasWellKnownAttribute(flag: WellKnownValAttributes) : bool = + x.flags &&& flag <> WellKnownValAttributes.None + + /// Get the underlying attribute list. + member x.AsList() = x.attribs + + /// Get the current flags value. + member x.Flags = x.flags + + /// Create from an attribute list. If empty, flags = None. Otherwise NotComputed. + static member Create(attribs: Attrib list) = + if attribs.IsEmpty then + WellKnownValAttribs([], WellKnownValAttributes.None) + else + WellKnownValAttribs(attribs, WellKnownValAttributes.NotComputed) + + /// Create with precomputed flags (used when flags are already known). + static member CreateWithFlags(attribs: Attrib list, flags: WellKnownValAttributes) = + WellKnownValAttribs(attribs, flags) + + /// Add a single attribute and OR-in its flag. + member x.Add(attrib: Attrib, flag: WellKnownValAttributes) = + WellKnownValAttribs(attrib :: x.attribs, x.flags ||| flag) + + /// Append attributes and OR-in flags. + member x.Append(others: Attrib list, flags: WellKnownValAttributes) = + WellKnownValAttribs(x.attribs @ others, x.flags ||| flags) + + /// Returns a copy with recomputed flags (flags set to NotComputed). + member x.WithRecomputedFlags() = + if x.attribs.IsEmpty then + WellKnownValAttribs([], WellKnownValAttributes.None) + else + WellKnownValAttribs(x.attribs, WellKnownValAttributes.NotComputed) + type Attribs = Attrib list [] @@ -5063,7 +5151,7 @@ type ArgReprInfo = { /// The attributes for the argument // MUTABILITY: used when propagating signature attributes into the implementation. - mutable Attribs: Attribs + mutable Attribs: WellKnownValAttribs /// The name for the argument at this position, if any // MUTABILITY: used when propagating names of parameters from signature into the implementation. @@ -6416,7 +6504,7 @@ type Construct() = val_xmldoc = doc val_member_info = specialRepr val_declaring_entity = actualParent - val_attribs = attribs } + val_attribs = WellKnownValAttribs.Create(attribs) } |> Some let flags = ValFlags(recValInfo, baseOrThis, isCompGen, inlineInfo, isMutable, isModuleOrMemberBinding, isExtensionMember, isIncrClassSpecialMember, isTyFunc, allowTypeInst, isGeneratedEventVal) diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index bed253cd80f..d2fdaeb88e6 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -1932,7 +1932,7 @@ type ValOptionalData = /// Custom attributes attached to the value. These contain references to other values (i.e. constructors in types). Mutable to fixup /// these value references after copying a collection of values. - mutable val_attribs: Attribs + mutable val_attribs: WellKnownValAttribs } override ToString: unit -> string @@ -1987,6 +1987,8 @@ type Val = member SetAttribs: attribs: Attribs -> unit + member SetValAttribs: attribs: WellKnownValAttribs -> unit + /// Set all the data on a value member SetData: tg: ValData -> unit @@ -2043,6 +2045,9 @@ type Val = /// Get the declared attributes for the value member Attribs: Attrib list + /// Get the declared attributes wrapper for the value + member ValAttribs: WellKnownValAttribs + /// Indicates if this is a 'base' or 'this' value? member BaseOrThisInfo: ValBaseOrThisInfo @@ -3288,6 +3293,52 @@ type WellKnownEntityAttribs = member Append: others: Attrib list * flags: WellKnownEntityAttributes -> WellKnownEntityAttribs member WithRecomputedFlags: unit -> WellKnownEntityAttribs +/// Flags enum for well-known attributes on Val (values and members). +[] +type WellKnownValAttributes = + | None = 0uL + | DllImportAttribute = 0x1uL + | EntryPointAttribute = 0x2uL + | LiteralAttribute = 0x4uL + | ConditionalAttribute = 0x8uL + | ReflectedDefinitionAttribute = 0x10uL + | RequiresExplicitTypeArgumentsAttribute = 0x20uL + | DefaultValueAttribute = 0x40uL + | SkipLocalsInitAttribute = 0x80uL + | ThreadStaticAttribute = 0x100uL + | ContextStaticAttribute = 0x200uL + | VolatileFieldAttribute = 0x400uL + | NoDynamicInvocationAttribute = 0x800uL + | ExtensionAttribute = 0x1000uL + | OptionalArgumentAttribute = 0x2000uL + | InAttribute = 0x4000uL + | OutAttribute = 0x8000uL + | ParamArrayAttribute = 0x10000uL + | CallerMemberNameAttribute = 0x20000uL + | CallerFilePathAttribute = 0x40000uL + | CallerLineNumberAttribute = 0x80000uL + | DefaultParameterValueAttribute = 0x100000uL + | ProjectionParameterAttribute = 0x200000uL + | InlineIfLambdaAttribute = 0x400000uL + | OptionalAttribute = 0x800000uL + | StructAttribute = 0x1000000uL + | NotComputed = 0x8000000000000000uL + +/// Wraps an Attrib list together with cached WellKnownValAttributes flags for O(1) lookup. +[] +type WellKnownValAttribs = + val private attribs: Attrib list + val private flags: WellKnownValAttributes + new: attribs: Attrib list * flags: WellKnownValAttributes -> WellKnownValAttribs + member HasWellKnownAttribute: flag: WellKnownValAttributes -> bool + member AsList: unit -> Attrib list + member Flags: WellKnownValAttributes + static member Create: attribs: Attrib list -> WellKnownValAttribs + static member CreateWithFlags: attribs: Attrib list * flags: WellKnownValAttributes -> WellKnownValAttribs + member Add: attrib: Attrib * flag: WellKnownValAttributes -> WellKnownValAttribs + member Append: others: Attrib list * flags: WellKnownValAttributes -> WellKnownValAttribs + member WithRecomputedFlags: unit -> WellKnownValAttribs + type Attribs = Attrib list [] @@ -3589,7 +3640,7 @@ type ArgReprInfo = { /// The attributes for the argument - mutable Attribs: Attribs + mutable Attribs: WellKnownValAttribs /// The name for the argument at this position, if any mutable Name: Ident option diff --git a/src/Compiler/TypedTree/TypedTreeBasics.fs b/src/Compiler/TypedTree/TypedTreeBasics.fs index a615b888c8f..746fd3008ad 100644 --- a/src/Compiler/TypedTree/TypedTreeBasics.fs +++ b/src/Compiler/TypedTree/TypedTreeBasics.fs @@ -22,13 +22,13 @@ assert (sizeof = 4) /// Metadata on values (names of arguments etc.) module ValReprInfo = - let unnamedTopArg1: ArgReprInfo = { Attribs = []; Name = None; OtherRange = None } + let unnamedTopArg1: ArgReprInfo = { Attribs = WellKnownValAttribs.Create([]); Name = None; OtherRange = None } let unnamedTopArg = [unnamedTopArg1] let unitArgData: ArgReprInfo list list = [[]] - let unnamedRetVal: ArgReprInfo = { Attribs = []; Name = None; OtherRange = None } + let unnamedRetVal: ArgReprInfo = { Attribs = WellKnownValAttribs.Create([]); Name = None; OtherRange = None } let selfMetadata = unnamedTopArg @@ -36,12 +36,12 @@ module ValReprInfo = let IsEmpty info = match info with - | ValReprInfo([], [], { Attribs = []; Name = None; OtherRange = None }) -> true + | ValReprInfo([], [], retInfo) when retInfo.Attribs.AsList().IsEmpty && retInfo.Name.IsNone && retInfo.OtherRange.IsNone -> true | _ -> false let InferTyparInfo (tps: Typar list) = tps |> List.map (fun tp -> TyparReprInfo(tp.Id, tp.Kind)) - let InferArgReprInfo (v: Val) : ArgReprInfo = { Attribs = []; Name = Some v.Id; OtherRange = None } + let InferArgReprInfo (v: Val) : ArgReprInfo = { Attribs = WellKnownValAttribs.Create([]); Name = Some v.Id; OtherRange = None } let InferArgReprInfos (vs: Val list list) = ValReprInfo([], List.mapSquared InferArgReprInfo vs, unnamedRetVal) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 49aa2190c41..136c5351e1c 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3796,6 +3796,96 @@ let EntityHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownEntityAttributes) else ea.HasWellKnownAttribute(flag) +let computeValWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownValAttributes = + let mutable flags = WellKnownValAttributes.None + + for attrib in attribs do + let (Attrib(tcref, _, _, _, _, _, _)) = attrib + + if + (match g.attrib_DllImportAttribute with + | Some a -> tyconRefEq g tcref a.TyconRef + | None -> false) + then + flags <- flags ||| WellKnownValAttributes.DllImportAttribute + elif tyconRefEq g tcref g.attrib_EntryPointAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.EntryPointAttribute + elif tyconRefEq g tcref g.attrib_LiteralAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.LiteralAttribute + elif tyconRefEq g tcref g.attrib_ConditionalAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.ConditionalAttribute + elif tyconRefEq g tcref g.attrib_ReflectedDefinitionAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.ReflectedDefinitionAttribute + elif tyconRefEq g tcref g.attrib_RequiresExplicitTypeArgumentsAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.RequiresExplicitTypeArgumentsAttribute + elif tyconRefEq g tcref g.attrib_DefaultValueAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.DefaultValueAttribute + elif tyconRefEq g tcref g.attrib_SkipLocalsInitAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.SkipLocalsInitAttribute + elif + (match g.attrib_ThreadStaticAttribute with + | Some a -> tyconRefEq g tcref a.TyconRef + | None -> false) + then + flags <- flags ||| WellKnownValAttributes.ThreadStaticAttribute + elif + (match g.attrib_ContextStaticAttribute with + | Some a -> tyconRefEq g tcref a.TyconRef + | None -> false) + then + flags <- flags ||| WellKnownValAttributes.ContextStaticAttribute + elif tyconRefEq g tcref g.attrib_VolatileFieldAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.VolatileFieldAttribute + elif tyconRefEq g tcref g.attrib_NoDynamicInvocationAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.NoDynamicInvocationAttribute + elif tyconRefEq g tcref g.attrib_ExtensionAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.ExtensionAttribute + elif tyconRefEq g tcref g.attrib_OptionalArgumentAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.OptionalArgumentAttribute + elif tyconRefEq g tcref g.attrib_InAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.InAttribute + elif tyconRefEq g tcref g.attrib_OutAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.OutAttribute + elif tyconRefEq g tcref g.attrib_ParamArrayAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.ParamArrayAttribute + elif tyconRefEq g tcref g.attrib_CallerMemberNameAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.CallerMemberNameAttribute + elif tyconRefEq g tcref g.attrib_CallerFilePathAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.CallerFilePathAttribute + elif tyconRefEq g tcref g.attrib_CallerLineNumberAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.CallerLineNumberAttribute + elif + (match g.attrib_DefaultParameterValueAttribute with + | Some a -> tyconRefEq g tcref a.TyconRef + | None -> false) + then + flags <- flags ||| WellKnownValAttributes.DefaultParameterValueAttribute + elif tyconRefEq g tcref g.attrib_ProjectionParameterAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.ProjectionParameterAttribute + elif tyconRefEq g tcref g.attrib_InlineIfLambdaAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.InlineIfLambdaAttribute + elif + (match g.attrib_OptionalAttribute with + | Some a -> tyconRefEq g tcref a.TyconRef + | None -> false) + then + flags <- flags ||| WellKnownValAttributes.OptionalAttribute + elif tyconRefEq g tcref g.attrib_StructAttribute.TyconRef then + flags <- flags ||| WellKnownValAttributes.StructAttribute + + flags + +/// Check if a Val has a specific well-known attribute, computing and caching flags if needed. +let ValHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownValAttributes) (v: Val) : bool = + let va = v.ValAttribs + + if va.Flags &&& WellKnownValAttributes.NotComputed <> WellKnownValAttributes.None then + let flags = computeValWellKnownFlags g (va.AsList()) + v.SetValAttribs(WellKnownValAttribs.CreateWithFlags(va.AsList(), flags)) + flags &&& flag <> WellKnownValAttributes.None + else + va.HasWellKnownAttribute(flag) + /// Analyze three cases for attributes declared on type definitions: IL-declared attributes, F#-declared attributes and /// provided attributes. // @@ -5938,9 +6028,9 @@ let InferValReprInfoOfExpr g allowTypeDirectedDetupling ty partialArgAttribsL re let attribs = if partialAttribs.Length = tys.Length then partialAttribs else tys |> List.map (fun _ -> []) - (ids, attribs) ||> List.map2 (fun id attribs -> { Name = id; Attribs = attribs; OtherRange = None }: ArgReprInfo )) + (ids, attribs) ||> List.map2 (fun id attribs -> { Name = id; Attribs = WellKnownValAttribs.Create(attribs); OtherRange = None }: ArgReprInfo )) - let retInfo: ArgReprInfo = { Attribs = retAttribs; Name = None; OtherRange = None } + let retInfo: ArgReprInfo = { Attribs = WellKnownValAttribs.Create(retAttribs); Name = None; OtherRange = None } let info = ValReprInfo (ValReprInfo.InferTyparInfo tps, curriedArgInfos, retInfo) if ValReprInfo.IsEmpty info then ValReprInfo.emptyValData else info @@ -6143,7 +6233,7 @@ and remapPossibleForallTyImpl ctxt tmenv ty = remapTypeFull (remapAttribs ctxt tmenv) tmenv ty and remapArgData ctxt tmenv (argInfo: ArgReprInfo) : ArgReprInfo = - { Attribs = remapAttribs ctxt tmenv argInfo.Attribs; Name = argInfo.Name; OtherRange = argInfo.OtherRange } + { Attribs = WellKnownValAttribs.Create(remapAttribs ctxt tmenv (argInfo.Attribs.AsList())); Name = argInfo.Name; OtherRange = argInfo.OtherRange } and remapValReprInfo ctxt tmenv (ValReprInfo(tpNames, arginfosl, retInfo)) = ValReprInfo(tpNames, List.mapSquared (remapArgData ctxt tmenv) arginfosl, remapArgData ctxt tmenv retInfo) @@ -6165,7 +6255,7 @@ and remapValData ctxt tmenv (d: ValData) = val_declaring_entity = declaringEntityR val_repr_info = reprInfoR val_member_info = memberInfoR - val_attribs = attribsR } + val_attribs = WellKnownValAttribs.Create(attribsR) } | None -> None } and remapParentRef tyenv p = diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 13f0a860095..3e228516ac0 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2399,6 +2399,11 @@ val computeEntityWellKnownFlags: g: TcGlobals -> attribs: Attribs -> WellKnownEn /// Check if an Entity has a specific well-known attribute, computing and caching flags if needed. val EntityHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownEntityAttributes -> entity: Entity -> bool +val computeValWellKnownFlags: g: TcGlobals -> attribs: Attribs -> WellKnownValAttributes + +/// Check if a Val has a specific well-known attribute, computing and caching flags if needed. +val ValHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownValAttributes -> v: Val -> bool + val IsMatchingFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attrib -> bool val IsMatchingFSharpAttributeOpt: TcGlobals -> BuiltinAttribInfo option -> Attrib -> bool diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index a94982d47c9..ab09c556b68 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -2591,7 +2591,7 @@ let fill_u_constraints, u_constraints = u_hole () let fill_u_Vals, u_Vals = u_hole () let p_ArgReprInfo (x: ArgReprInfo) st = - p_attribs x.Attribs st + p_attribs (x.Attribs.AsList()) st p_option p_ident x.Name st let p_TyparReprInfo (TyparReprInfo(a, b)) st = @@ -2611,7 +2611,7 @@ let u_ArgReprInfo st = | [], None -> ValReprInfo.unnamedTopArg1 | _ -> { - Attribs = a + Attribs = WellKnownValAttribs.Create(a) Name = b OtherRange = None } @@ -3313,7 +3313,7 @@ and u_ValData st = val_member_info = x8 val_declaring_entity = x13b val_xmldocsig = x12 - val_attribs = x9 + val_attribs = WellKnownValAttribs.Create(x9) } } diff --git a/src/Compiler/Utilities/TypeHashing.fs b/src/Compiler/Utilities/TypeHashing.fs index 7723e8b04df..7056e4c229c 100644 --- a/src/Compiler/Utilities/TypeHashing.fs +++ b/src/Compiler/Utilities/TypeHashing.fs @@ -233,7 +233,7 @@ module rec HashTypes = // Hash a single argument, including its name and type let private hashArgInfo (g: TcGlobals) (ty, argInfo: ArgReprInfo) = - let attributesHash = hashAttributeList argInfo.Attribs + let attributesHash = hashAttributeList (argInfo.Attribs.AsList()) let nameHash = match argInfo.Name with From 1ccb290fcdc0dfd302ca4484780b21de1053c448 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Sat, 21 Feb 2026 02:21:19 +0100 Subject: [PATCH 07/71] Sprint 05: Migrate Val/ArgReprInfo-level existence checks to well-known attribute flags - Add ArgReprInfoHasWellKnownAttribute helper in TypedTreeOps.fs/.fsi - Migrate 11 Val sites to ValHasWellKnownAttribute (O(1) flag test) - Migrate 19 ArgReprInfo sites to ArgReprInfoHasWellKnownAttribute - Migrate 7 Attrib list sites using computeValWellKnownFlags - Migrate 2 Entity sites to EntityHasWellKnownAttribute - Total: 39 existence-only attribute check sites migrated Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/AttributeChecking.fs | 2 +- src/Compiler/Checking/CheckDeclarations.fs | 4 ++-- .../Checking/CheckIncrementalClasses.fs | 2 +- .../Expressions/CheckComputationExpressions.fs | 2 +- .../Checking/Expressions/CheckExpressions.fs | 18 ++++++++++-------- src/Compiler/Checking/NicePrint.fs | 2 +- src/Compiler/Checking/PostInferenceChecks.fs | 14 +++++++------- src/Compiler/Checking/SignatureConformance.fs | 4 ++-- src/Compiler/Checking/infos.fs | 16 ++++++++-------- src/Compiler/CodeGen/IlxGen.fs | 6 +++--- src/Compiler/Symbols/SymbolHelpers.fs | 2 +- src/Compiler/Symbols/Symbols.fs | 8 ++++---- src/Compiler/TypedTree/TypedTreeOps.fs | 11 +++++++++++ src/Compiler/TypedTree/TypedTreeOps.fsi | 3 +++ 14 files changed, 55 insertions(+), 39 deletions(-) diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index 9388bc238a8..ff9d19b275d 100755 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -554,7 +554,7 @@ let CheckMethInfoAttributes g m tyargsOpt (minfo: MethInfo) = let res = trackErrors { do! CheckFSharpAttributes g fsAttribs m - if Option.isNone tyargsOpt && HasFSharpAttribute g g.attrib_RequiresExplicitTypeArgumentsAttribute fsAttribs then + if Option.isNone tyargsOpt && (computeValWellKnownFlags g fsAttribs &&& WellKnownValAttributes.RequiresExplicitTypeArgumentsAttribute <> WellKnownValAttributes.None) then do! ErrorD(Error(FSComp.SR.tcFunctionRequiresExplicitTypeArguments(minfo.LogicalName), m)) } diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 2066fe3338a..c93f01f38bb 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -1406,7 +1406,7 @@ module MutRecBindingChecking = // Check to see that local bindings and members don't have the same name and check some other adhoc conditions for bind in binds do - if not isStatic && HasFSharpAttributeOpt g g.attrib_DllImportAttribute bind.Var.Attribs then + if not isStatic && ValHasWellKnownAttribute g WellKnownValAttributes.DllImportAttribute bind.Var then errorR(Error(FSComp.SR.tcDllImportNotAllowed(), bind.Var.Range)) let nm = bind.Var.DisplayName @@ -3720,7 +3720,7 @@ module EstablishTypeDefinitionCores = // and needs wrapping to int option. // Explicit [] path: string option already has wrapped type. let ty = - if HasFSharpAttribute g g.attrib_OptionalArgumentAttribute (argInfo.Attribs.AsList()) then + if ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.OptionalArgumentAttribute argInfo then if isOptionTy g ty || isValueOptionTy g ty then ty else diff --git a/src/Compiler/Checking/CheckIncrementalClasses.fs b/src/Compiler/Checking/CheckIncrementalClasses.fs index c94218973bd..846aa5f9085 100644 --- a/src/Compiler/Checking/CheckIncrementalClasses.fs +++ b/src/Compiler/Checking/CheckIncrementalClasses.fs @@ -228,7 +228,7 @@ let private MakeIncrClassField(g, cpath, formalTyparInst: TyparInstantiation, v: let id = ident (name, v.Range) let ty = v.Type |> instType formalTyparInst let taccess = TAccess [cpath] - let isVolatile = HasFSharpAttribute g g.attrib_VolatileFieldAttribute v.Attribs + let isVolatile = ValHasWellKnownAttribute g WellKnownValAttributes.VolatileFieldAttribute v Construct.NewRecdField isStatic None id false ty v.IsMutable isVolatile [] v.Attribs v.XmlDoc taccess true diff --git a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs index baf331d2f3a..1b0b9608fcf 100644 --- a/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs @@ -580,7 +580,7 @@ let isCustomOperationProjectionParameter ceenv i (nm: Ident) = | Some argInfos -> i < argInfos.Length && let _, argInfo = List.item i argInfos in - HasFSharpAttribute ceenv.cenv.g ceenv.cenv.g.attrib_ProjectionParameterAttribute (argInfo.Attribs.AsList())) + ArgReprInfoHasWellKnownAttribute ceenv.cenv.g WellKnownValAttributes.ProjectionParameterAttribute argInfo) if List.allEqual vs then vs[0] diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 13d563b29ed..88aae6c907d 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -2832,7 +2832,7 @@ let TcVal (cenv: cenv) env (tpenv: UnscopedTyparEnv) (vref: ValRef) instantiatio match instantiationInfoOpt with // No explicit instantiation (the normal case) | None -> - if HasFSharpAttribute g g.attrib_RequiresExplicitTypeArgumentsAttribute v.Attribs then + if ValHasWellKnownAttribute g WellKnownValAttributes.RequiresExplicitTypeArgumentsAttribute v then errorR(Error(FSComp.SR.tcFunctionRequiresExplicitTypeArguments(v.DisplayName), m)) match valRecInfo with @@ -6545,7 +6545,7 @@ and TcIteratedLambdas (cenv: cenv) isFirst (env: TcEnv) overallTy takenNames tpe if infos.Length = vspecs.Length then (vspecs, infos) ||> List.iter2 (fun v argInfo -> v.SetArgReprInfoForDisplay (Some argInfo) - let inlineIfLambda = HasFSharpAttribute g g.attrib_InlineIfLambdaAttribute (argInfo.Attribs.AsList()) + let inlineIfLambda = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.InlineIfLambdaAttribute argInfo if inlineIfLambda then v.SetInlineIfLambda()) { envinner with eLambdaArgInfos = rest } @@ -11121,14 +11121,16 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt SynValData(valMf, SynValInfo(args, SynArgInfo({Attributes=rotRetSynAttrs; Range=mHead} :: attrs, opt, retId)), valId) retAttribs, valAttribs, valSynData - let isVolatile = HasFSharpAttribute g g.attrib_VolatileFieldAttribute valAttribs + let valAttribFlags = computeValWellKnownFlags g valAttribs + + let isVolatile = valAttribFlags &&& WellKnownValAttributes.VolatileFieldAttribute <> WellKnownValAttributes.None let inlineFlag = ComputeInlineFlag memberFlagsOpt isInline isMutable g valAttribs mBinding let argAttribs = spatsL |> List.map (SynInfo.InferSynArgInfoFromSimplePats >> List.map (SynInfo.AttribsOfArgData >> TcAttrs AttributeTargets.Parameter false)) // Assert the return type of an active pattern. A [] attribute may be used on a partial active pattern. - let isStructRetTy = HasFSharpAttribute g g.attrib_StructAttribute retAttribs + let isStructRetTy = computeValWellKnownFlags g retAttribs &&& WellKnownValAttributes.StructAttribute <> WellKnownValAttributes.None let argAndRetAttribs = ArgAndRetAttribs(argAttribs, retAttribs) @@ -11145,7 +11147,7 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt | _ -> false | _ -> false - if HasFSharpAttribute g g.attrib_DefaultValueAttribute valAttribs && not isZeroMethod then + if valAttribFlags &&& WellKnownValAttributes.DefaultValueAttribute <> WellKnownValAttributes.None && not isZeroMethod then errorR(Error(FSComp.SR.tcDefaultValueAttributeRequiresVal(), mBinding)) let isThreadStatic = isThreadOrContextStatic g valAttribs @@ -11163,13 +11165,13 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt errorR(Error(FSComp.SR.tcFixedNotAllowed(), mBinding)) if (not declKind.CanBeDllImport || (match memberFlagsOpt with Some memberFlags -> memberFlags.IsInstance | _ -> false)) && - HasFSharpAttributeOpt g g.attrib_DllImportAttribute valAttribs then + valAttribFlags &&& WellKnownValAttributes.DllImportAttribute <> WellKnownValAttributes.None then errorR(Error(FSComp.SR.tcDllImportNotAllowed(), mBinding)) - if Option.isNone memberFlagsOpt && HasFSharpAttribute g g.attrib_ConditionalAttribute valAttribs then + if Option.isNone memberFlagsOpt && valAttribFlags &&& WellKnownValAttributes.ConditionalAttribute <> WellKnownValAttributes.None then errorR(Error(FSComp.SR.tcConditionalAttributeRequiresMembers(), mBinding)) - if HasFSharpAttribute g g.attrib_EntryPointAttribute valAttribs then + if valAttribFlags &&& WellKnownValAttributes.EntryPointAttribute <> WellKnownValAttributes.None then if Option.isSome memberFlagsOpt then errorR(Error(FSComp.SR.tcEntryPointAttributeRequiresFunctionInModule(), mBinding)) else diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index 5aad7d370d4..b3c93f82b8a 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -1084,7 +1084,7 @@ module PrintTypes = let g = denv.g // Detect an optional argument - let isOptionalArg = HasFSharpAttribute g g.attrib_OptionalArgumentAttribute (argInfo.Attribs.AsList()) + let isOptionalArg = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.OptionalArgumentAttribute argInfo match argInfo.Name, isOptionalArg, tryDestOptionTy g ty with // Layout an optional argument diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 92693c64443..96d3e62eae9 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -2076,7 +2076,7 @@ and CheckBinding cenv env alwaysCheckNoReraise ctxt (TBind(v, bindRhs, _) as bin let isTop = Option.isSome bind.Var.ValReprInfo //printfn "visiting %s..." v.DisplayName - let env = { env with external = env.external || g.attrib_DllImportAttribute |> Option.exists (fun attr -> HasFSharpAttribute g attr v.Attribs) } + let env = { env with external = env.external || ValHasWellKnownAttribute g WellKnownValAttributes.DllImportAttribute v } // Check that active patterns don't have free type variables in their result match TryGetActivePatternInfo vref with @@ -2119,7 +2119,7 @@ and CheckBinding cenv env alwaysCheckNoReraise ctxt (TBind(v, bindRhs, _) as bin (// Check the attributes on any enclosing module env.reflect || // Check the attributes on the value - HasFSharpAttribute g g.attrib_ReflectedDefinitionAttribute v.Attribs || + ValHasWellKnownAttribute g WellKnownValAttributes.ReflectedDefinitionAttribute v || // Also check the enclosing type for members - for historical reasons, in the TAST member values // are stored in the entity that encloses the type, hence we will not have noticed the ReflectedDefinition // on the enclosing type at this point. @@ -2189,7 +2189,7 @@ and CheckBindings cenv env binds = // Top binds introduce expression, check they are reraise free. let CheckModuleBinding cenv env (TBind(v, e, _) as bind) = let g = cenv.g - let isExplicitEntryPoint = HasFSharpAttribute g g.attrib_EntryPointAttribute v.Attribs + let isExplicitEntryPoint = ValHasWellKnownAttribute g WellKnownValAttributes.EntryPointAttribute v if isExplicitEntryPoint then cenv.entryPointGiven <- true let isLastCompiland = fst cenv.isLastCompiland @@ -2200,9 +2200,9 @@ let CheckModuleBinding cenv env (TBind(v, e, _) as bind) = if // Mutable values always have fields not v.IsMutable && // Literals always have fields - not (HasFSharpAttribute g g.attrib_LiteralAttribute v.Attribs) && - not (HasFSharpAttributeOpt g g.attrib_ThreadStaticAttribute v.Attribs) && - not (HasFSharpAttributeOpt g g.attrib_ContextStaticAttribute v.Attribs) && + not (ValHasWellKnownAttribute g WellKnownValAttributes.LiteralAttribute v) && + not (ValHasWellKnownAttribute g WellKnownValAttributes.ThreadStaticAttribute v) && + not (ValHasWellKnownAttribute g WellKnownValAttributes.ContextStaticAttribute v) && // Having a field makes the binding a static initialization trigger IsSimpleSyntacticConstantExpr g e && // Check the thing is actually compiled as a property @@ -2753,7 +2753,7 @@ and CheckModuleSpec cenv env mbind = CheckModuleBinding cenv env bind | ModuleOrNamespaceBinding.Module (mspec, rhs) -> CheckEntityDefn cenv env mspec - let env = { env with reflect = env.reflect || HasFSharpAttribute cenv.g cenv.g.attrib_ReflectedDefinitionAttribute mspec.Attribs } + let env = { env with reflect = env.reflect || EntityHasWellKnownAttribute cenv.g WellKnownEntityAttributes.ReflectedDefinitionAttribute mspec } CheckDefnInModule cenv env rhs let CheckImplFileContents cenv env implFileTy implFileContents = diff --git a/src/Compiler/Checking/SignatureConformance.fs b/src/Compiler/Checking/SignatureConformance.fs index d124d3794c1..5c947bda13c 100644 --- a/src/Compiler/Checking/SignatureConformance.fs +++ b/src/Compiler/Checking/SignatureConformance.fs @@ -314,8 +314,8 @@ type Checker(g, amap, denv, remapInfo: SignatureRepackageInfo, checkingSig) = warning(ArgumentsInSigAndImplMismatch(sname, iname)) | _ -> () - let sigHasInlineIfLambda = HasFSharpAttribute g g.attrib_InlineIfLambdaAttribute (sigArgInfo.Attribs.AsList()) - let implHasInlineIfLambda = HasFSharpAttribute g g.attrib_InlineIfLambdaAttribute (implArgInfo.Attribs.AsList()) + let sigHasInlineIfLambda = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.InlineIfLambdaAttribute sigArgInfo + let implHasInlineIfLambda = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.InlineIfLambdaAttribute implArgInfo let m = match implArgInfo.Name with | Some iname-> iname.idRange diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index 19a00c60af9..500eba0f6b2 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -275,15 +275,15 @@ type ParamAttribs = ParamAttribs of isParamArrayArg: bool * isInArg: bool * isOu let CrackParamAttribsInfo g (ty: TType, argInfo: ArgReprInfo) = let attribs = argInfo.Attribs.AsList() - let isParamArrayArg = HasFSharpAttribute g g.attrib_ParamArrayAttribute attribs + let isParamArrayArg = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.ParamArrayAttribute argInfo let reflArgInfo = match TryFindFSharpBoolAttributeAssumeFalse g g.attrib_ReflectedDefinitionAttribute attribs with | Some b -> ReflectedArgInfo.Quote b | None -> ReflectedArgInfo.None - let isOutArg = (HasFSharpAttribute g g.attrib_OutAttribute attribs && isByrefTy g ty) || isOutByrefTy g ty - let isInArg = (HasFSharpAttribute g g.attrib_InAttribute attribs && isByrefTy g ty) || isInByrefTy g ty - let isCalleeSideOptArg = HasFSharpAttribute g g.attrib_OptionalArgumentAttribute attribs - let isCallerSideOptArg = HasFSharpAttributeOpt g g.attrib_OptionalAttribute attribs + let isOutArg = (ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.OutAttribute argInfo && isByrefTy g ty) || isOutByrefTy g ty + let isInArg = (ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.InAttribute argInfo && isByrefTy g ty) || isInByrefTy g ty + let isCalleeSideOptArg = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.OptionalArgumentAttribute argInfo + let isCallerSideOptArg = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.OptionalAttribute argInfo let optArgInfo = if isCalleeSideOptArg then CalleeSide @@ -311,9 +311,9 @@ let CrackParamAttribsInfo g (ty: TType, argInfo: ArgReprInfo) = NotOptional else NotOptional - let isCallerLineNumberArg = HasFSharpAttribute g g.attrib_CallerLineNumberAttribute attribs - let isCallerFilePathArg = HasFSharpAttribute g g.attrib_CallerFilePathAttribute attribs - let isCallerMemberNameArg = HasFSharpAttribute g g.attrib_CallerMemberNameAttribute attribs + let isCallerLineNumberArg = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.CallerLineNumberAttribute argInfo + let isCallerFilePathArg = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.CallerFilePathAttribute argInfo + let isCallerMemberNameArg = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.CallerMemberNameAttribute argInfo let callerInfo = match isCallerLineNumberArg, isCallerFilePathArg, isCallerMemberNameArg with diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 49975571e82..a3ce2509cf4 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -863,7 +863,7 @@ let GenFieldSpecForStaticField (isInteractive, g: TcGlobals, ilContainerTy, vspe let fieldName = vspec.CompiledName g.CompilerGlobalState - if HasFSharpAttribute g g.attrib_LiteralAttribute vspec.Attribs then + if ValHasWellKnownAttribute g WellKnownValAttributes.LiteralAttribute vspec then mkILFieldSpecInTy (ilContainerTy, fieldName, ilTy) elif isInteractive then mkILFieldSpecInTy (ilContainerTy, CompilerGeneratedName fieldName, ilTy) @@ -9258,7 +9258,7 @@ and GenMethodForBinding let eenvForMeth = if eenvForMeth.initLocals - && HasFSharpAttribute g g.attrib_SkipLocalsInitAttribute v.Attribs + && ValHasWellKnownAttribute g WellKnownValAttributes.SkipLocalsInitAttribute v then { eenvForMeth with initLocals = false } else @@ -10361,7 +10361,7 @@ and GenModuleBinding cenv (cgbuf: CodeGenBuffer) (qname: QualifiedNameOfFile) la cloc = CompLocForFixedModule cenv.options.fragName qname.Text mspec initLocals = eenv.initLocals - && not (HasFSharpAttribute cenv.g cenv.g.attrib_SkipLocalsInitAttribute mspec.Attribs) + && not (EntityHasWellKnownAttribute cenv.g WellKnownEntityAttributes.SkipLocalsInitAttribute mspec) } // Create the class to hold the contents of this module. No class needed if diff --git a/src/Compiler/Symbols/SymbolHelpers.fs b/src/Compiler/Symbols/SymbolHelpers.fs index fceee8269e7..742e7640293 100644 --- a/src/Compiler/Symbols/SymbolHelpers.fs +++ b/src/Compiler/Symbols/SymbolHelpers.fs @@ -238,7 +238,7 @@ module internal SymbolHelpers = // Drop the first 'seq' argument representing the computation space let argInfos = if argInfos.IsEmpty then [] else argInfos.Tail [ for ty, argInfo in argInfos do - let isPP = HasFSharpAttribute g g.attrib_ProjectionParameterAttribute (argInfo.Attribs.AsList()) + let isPP = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.ProjectionParameterAttribute argInfo // Strip the tuple space type of the type of projection parameters let ty = if isPP && isFunTy g ty then rangeOfFunTy g ty else ty yield ParamNameAndType(argInfo.Name, ty) ] diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs index ad5b1cf6e06..d89b7bf2bd4 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -2181,10 +2181,10 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = [ for argTys in argTysl do yield [ for argTy, argInfo in argTys do - let isParamArrayArg = HasFSharpAttribute cenv.g cenv.g.attrib_ParamArrayAttribute (argInfo.Attribs.AsList()) - let isInArg = HasFSharpAttribute cenv.g cenv.g.attrib_InAttribute (argInfo.Attribs.AsList()) && isByrefTy cenv.g argTy - let isOutArg = HasFSharpAttribute cenv.g cenv.g.attrib_OutAttribute (argInfo.Attribs.AsList()) && isByrefTy cenv.g argTy - let isOptionalArg = HasFSharpAttribute cenv.g cenv.g.attrib_OptionalArgumentAttribute (argInfo.Attribs.AsList()) + let isParamArrayArg = ArgReprInfoHasWellKnownAttribute cenv.g WellKnownValAttributes.ParamArrayAttribute argInfo + let isInArg = ArgReprInfoHasWellKnownAttribute cenv.g WellKnownValAttributes.InAttribute argInfo && isByrefTy cenv.g argTy + let isOutArg = ArgReprInfoHasWellKnownAttribute cenv.g WellKnownValAttributes.OutAttribute argInfo && isByrefTy cenv.g argTy + let isOptionalArg = ArgReprInfoHasWellKnownAttribute cenv.g WellKnownValAttributes.OptionalArgumentAttribute argInfo let m = match argInfo.Name with | Some v -> v.idRange diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 136c5351e1c..f3f606a1be8 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3875,6 +3875,17 @@ let computeValWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownValAtt flags +/// Check if an ArgReprInfo has a specific well-known attribute, computing and caching flags if needed. +let ArgReprInfoHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownValAttributes) (argInfo: ArgReprInfo) : bool = + let wa = argInfo.Attribs + + if wa.Flags &&& WellKnownValAttributes.NotComputed <> WellKnownValAttributes.None then + let flags = computeValWellKnownFlags g (wa.AsList()) + argInfo.Attribs <- WellKnownValAttribs.CreateWithFlags(wa.AsList(), flags) + flags &&& flag <> WellKnownValAttributes.None + else + wa.HasWellKnownAttribute(flag) + /// Check if a Val has a specific well-known attribute, computing and caching flags if needed. let ValHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownValAttributes) (v: Val) : bool = let va = v.ValAttribs diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 3e228516ac0..882d26f3c89 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2401,6 +2401,9 @@ val EntityHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownEntityAttributes val computeValWellKnownFlags: g: TcGlobals -> attribs: Attribs -> WellKnownValAttributes +/// Check if an ArgReprInfo has a specific well-known attribute, computing and caching flags if needed. +val ArgReprInfoHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownValAttributes -> argInfo: ArgReprInfo -> bool + /// Check if a Val has a specific well-known attribute, computing and caching flags if needed. val ValHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownValAttributes -> v: Val -> bool From acd72b09dee544ee5290fec8f8ae6410e278fdf4 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Sat, 21 Feb 2026 03:05:13 +0100 Subject: [PATCH 08/71] Sprint 6: Hybrid mapping functions and TyconRef migration Add mapILFlagToEntityFlag and mapILFlagToValFlag mapping functions to TypedTreeOps.fs for translating WellKnownILAttributes flags to their Entity and Val equivalents. Add TyconRefHasWellKnownAttribute unified hybrid check function that dispatches on IL vs F# vs provided type metadata using O(1) flag tests. Migrate 5 existence-only TyconRef hybrid sites: - NameResolution.fs: ExtensionAttribute check - PostInferenceChecks.fs: IsByRefLikeAttribute and IsReadOnlyAttribute checks - TypedTreeOps.fs: IsByRefLikeAttribute (isByrefLikeTyconRef) and IsReadOnlyAttribute (isTyconRefReadOnly) checks Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/NameResolution.fs | 2 +- src/Compiler/Checking/PostInferenceChecks.fs | 4 +- src/Compiler/TypedTree/TypedTreeOps.fs | 78 +++++++++++++++++++- src/Compiler/TypedTree/TypedTreeOps.fsi | 9 +++ 4 files changed, 86 insertions(+), 7 deletions(-) diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 21372737c12..21aaa7bd57f 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -528,7 +528,7 @@ let IsTyconRefUsedForCSharpStyleExtensionMembers g m (tcref: TyconRef) = match metadataOfTycon tcref.Deref with | ILTypeMetadata(TILObjectReprData(_, _, tdef)) -> tdef.CanContainExtensionMethods | _ -> true - && isNil(tcref.Typars m) && TyconRefHasAttribute g m g.attrib_ExtensionAttribute tcref + && isNil(tcref.Typars m) && TyconRefHasWellKnownAttribute g WellKnownILAttributes.ExtensionAttribute tcref /// Checks if the type is used for C# style extension members. let IsTypeUsedForCSharpStyleExtensionMembers g m ty = diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 96d3e62eae9..e28f9bfe3af 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -2567,10 +2567,10 @@ let CheckEntityDefn cenv env (tycon: Entity) = errorR(Error(FSComp.SR.chkDuplicateMethodInheritedTypeWithSuffix nm, m)) - if TyconRefHasAttributeByName m tname_IsByRefLikeAttribute tcref && not tycon.IsStructOrEnumTycon then + if TyconRefHasWellKnownAttribute g WellKnownILAttributes.IsByRefLikeAttribute tcref && not tycon.IsStructOrEnumTycon then errorR(Error(FSComp.SR.tcByRefLikeNotStruct(), tycon.Range)) - if TyconRefHasAttribute g m g.attrib_IsReadOnlyAttribute tcref && not tycon.IsStructOrEnumTycon then + if TyconRefHasWellKnownAttribute g WellKnownILAttributes.IsReadOnlyAttribute tcref && not tycon.IsStructOrEnumTycon then errorR(Error(FSComp.SR.tcIsReadOnlyNotStruct(), tycon.Range)) // Considers TFSharpTyconRepr and TFSharpUnionRepr. diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index f3f606a1be8..a352d366fb1 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3785,6 +3785,31 @@ let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEnt flags +/// Map a WellKnownILAttributes flag to its WellKnownEntityAttributes equivalent. +/// Used for hybrid check sites that dispatch on IL vs F# metadata. +let mapILFlagToEntityFlag (flag: WellKnownILAttributes) : WellKnownEntityAttributes = + match flag with + | WellKnownILAttributes.IsReadOnlyAttribute -> WellKnownEntityAttributes.IsReadOnlyAttribute + | WellKnownILAttributes.IsByRefLikeAttribute -> WellKnownEntityAttributes.IsByRefLikeAttribute + | WellKnownILAttributes.ExtensionAttribute -> WellKnownEntityAttributes.ExtensionAttribute + | WellKnownILAttributes.AllowNullLiteralAttribute -> WellKnownEntityAttributes.AllowNullLiteralAttribute + | WellKnownILAttributes.AutoOpenAttribute -> WellKnownEntityAttributes.AutoOpenAttribute + | WellKnownILAttributes.ReflectedDefinitionAttribute -> WellKnownEntityAttributes.ReflectedDefinitionAttribute + | WellKnownILAttributes.DefaultMemberAttribute -> WellKnownEntityAttributes.None + | WellKnownILAttributes.NoEagerConstraintApplicationAttribute -> WellKnownEntityAttributes.None + | _ -> WellKnownEntityAttributes.None + +/// Map a WellKnownILAttributes flag to its WellKnownValAttributes equivalent. +let mapILFlagToValFlag (flag: WellKnownILAttributes) : WellKnownValAttributes = + match flag with + | WellKnownILAttributes.ExtensionAttribute -> WellKnownValAttributes.ExtensionAttribute + | WellKnownILAttributes.ParamArrayAttribute -> WellKnownValAttributes.ParamArrayAttribute + | WellKnownILAttributes.CallerMemberNameAttribute -> WellKnownValAttributes.CallerMemberNameAttribute + | WellKnownILAttributes.CallerFilePathAttribute -> WellKnownValAttributes.CallerFilePathAttribute + | WellKnownILAttributes.CallerLineNumberAttribute -> WellKnownValAttributes.CallerLineNumberAttribute + | WellKnownILAttributes.NoEagerConstraintApplicationAttribute -> WellKnownValAttributes.None + | _ -> WellKnownValAttributes.None + /// Check if an Entity has a specific well-known attribute, computing and caching flags if needed. let EntityHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownEntityAttributes) (entity: Entity) : bool = let ea = entity.EntityAttribs @@ -3963,6 +3988,49 @@ let TyconRefHasAttribute g m attribSpec tcref = (fun _ -> Some ()) |> Option.isSome +/// Check if a TyconRef has a well-known attribute, handling both IL and F# metadata. +/// Uses O(1) flag tests on both paths. +let TyconRefHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownILAttributes) (tcref: TyconRef) : bool = + match metadataOfTycon tcref.Deref with +#if !NO_TYPEPROVIDERS + | ProvidedTypeMetadata info -> + let provAttribs = + info.ProvidedType.PApply((fun a -> (a :> IProvidedCustomAttributeProvider)), tcref.Range) + + let attrFullName = + match flag with + | WellKnownILAttributes.IsReadOnlyAttribute -> g.attrib_IsReadOnlyAttribute.TypeRef.FullName + | WellKnownILAttributes.IsByRefLikeAttribute -> + match g.attrib_IsByRefLikeAttribute_opt with + | Some attr -> attr.TypeRef.FullName + | None -> "" + | WellKnownILAttributes.ExtensionAttribute -> g.attrib_ExtensionAttribute.TypeRef.FullName + | WellKnownILAttributes.AllowNullLiteralAttribute -> g.attrib_AllowNullLiteralAttribute.TypeRef.FullName + | WellKnownILAttributes.AutoOpenAttribute -> g.attrib_AutoOpenAttribute.TypeRef.FullName + | WellKnownILAttributes.ReflectedDefinitionAttribute -> g.attrib_ReflectedDefinitionAttribute.TypeRef.FullName + | _ -> "" + + if attrFullName = "" then + false + else + provAttribs + .PUntaint( + (fun a -> + a + .GetAttributeConstructorArgs(provAttribs.TypeProvider.PUntaintNoFailure id, attrFullName)), + tcref.Range + ) + .IsSome +#endif + | ILTypeMetadata(TILObjectReprData(_, _, tdef)) -> tdef.HasWellKnownAttribute(g, flag) + | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> + let entityFlag = mapILFlagToEntityFlag flag + + if entityFlag <> WellKnownEntityAttributes.None then + EntityHasWellKnownAttribute g entityFlag tcref.Deref + else + false + let HasDefaultAugmentationAttribute g (tcref: TyconRef) = match TryFindFSharpAttribute g g.attrib_DefaultAugmentationAttribute tcref.Attribs with | Some(Attrib(_, _, [ AttribBoolArg b ], _, _, _, _)) -> b @@ -4003,14 +4071,15 @@ let isByrefTyconRef (g: TcGlobals) (tcref: TyconRef) = tyconRefEqOpt g g.system_RuntimeArgumentHandle_tcref tcref // See RFC FS-1053.md -let isByrefLikeTyconRef (g: TcGlobals) m (tcref: TyconRef) = +let isByrefLikeTyconRef (g: TcGlobals) (m: range) (tcref: TyconRef) = + ignore m tcref.CanDeref && match tcref.TryIsByRefLike with | ValueSome res -> res | _ -> let res = isByrefTyconRef g tcref || - (isStructTyconRef tcref && TyconRefHasAttributeByName m tname_IsByRefLikeAttribute tcref) + (isStructTyconRef tcref && TyconRefHasWellKnownAttribute g WellKnownILAttributes.IsByRefLikeAttribute tcref) tcref.SetIsByRefLike res res @@ -7361,13 +7430,14 @@ let isRecdOrStructTyconRefAssumedImmutable (g: TcGlobals) (tcref: TyconRef) = tyconRefEq g tcref g.decimal_tcr || tyconRefEq g tcref g.date_tcr -let isTyconRefReadOnly g m (tcref: TyconRef) = +let isTyconRefReadOnly g (m: range) (tcref: TyconRef) = + ignore m tcref.CanDeref && if match tcref.TryIsReadOnly with | ValueSome res -> res | _ -> - let res = TyconRefHasAttribute g m g.attrib_IsReadOnlyAttribute tcref + let res = TyconRefHasWellKnownAttribute g WellKnownILAttributes.IsReadOnlyAttribute tcref tcref.SetIsReadOnly res res then true diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 882d26f3c89..be0489f16b5 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2399,6 +2399,12 @@ val computeEntityWellKnownFlags: g: TcGlobals -> attribs: Attribs -> WellKnownEn /// Check if an Entity has a specific well-known attribute, computing and caching flags if needed. val EntityHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownEntityAttributes -> entity: Entity -> bool +/// Map a WellKnownILAttributes flag to its WellKnownEntityAttributes equivalent. +val mapILFlagToEntityFlag: flag: WellKnownILAttributes -> WellKnownEntityAttributes + +/// Map a WellKnownILAttributes flag to its WellKnownValAttributes equivalent. +val mapILFlagToValFlag: flag: WellKnownILAttributes -> WellKnownValAttributes + val computeValWellKnownFlags: g: TcGlobals -> attribs: Attribs -> WellKnownValAttributes /// Check if an ArgReprInfo has a specific well-known attribute, computing and caching flags if needed. @@ -2443,6 +2449,9 @@ val TyconRefHasAttribute: TcGlobals -> range -> BuiltinAttribInfo -> TyconRef -> /// Try to find an attribute with a specific full name on a type definition val TyconRefHasAttributeByName: range -> string -> TyconRef -> bool +/// Check if a TyconRef has a well-known attribute, handling both IL and F# metadata with O(1) flag tests. +val TyconRefHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownILAttributes -> tcref: TyconRef -> bool + /// Try to find the AttributeUsage attribute, looking for the value of the AllowMultiple named parameter val TryFindAttributeUsageAttribute: TcGlobals -> range -> TyconRef -> bool option From 5f5a65e4049a4b817e400e0cee904bdddbd1abe0 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Sat, 21 Feb 2026 05:01:07 +0100 Subject: [PATCH 09/71] Sprint 7: Final validation fixes - conditional compile mapILFlagToAttribInfo - Wrap mapILFlagToAttribInfo in #if !NO_TYPEPROVIDERS to fix FS1182 unused value error on netstandard2.0 target - Simplify ProvidedTypeMetadata case in TyconRefHasWellKnownAttribute to reuse TyconRefHasAttribute via the new helper - All component tests pass (6630/6630) - All import tests pass (63/63) - All CompilerCompat cross-version tests pass (6/6) - All service tests pass (2089/2089) - All scripting tests pass (99/99) Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TypedTreeOps.fs | 45 ++++++++++---------------- 1 file changed, 17 insertions(+), 28 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index a352d366fb1..4df2b95bf02 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3785,6 +3785,19 @@ let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEnt flags +#if !NO_TYPEPROVIDERS +/// Map a WellKnownILAttributes flag to its AttribInfo equivalent. +let mapILFlagToAttribInfo (g: TcGlobals) (flag: WellKnownILAttributes) : BuiltinAttribInfo option = + match flag with + | WellKnownILAttributes.IsReadOnlyAttribute -> Some g.attrib_IsReadOnlyAttribute + | WellKnownILAttributes.IsByRefLikeAttribute -> g.attrib_IsByRefLikeAttribute_opt + | WellKnownILAttributes.ExtensionAttribute -> Some g.attrib_ExtensionAttribute + | WellKnownILAttributes.AllowNullLiteralAttribute -> Some g.attrib_AllowNullLiteralAttribute + | WellKnownILAttributes.AutoOpenAttribute -> Some g.attrib_AutoOpenAttribute + | WellKnownILAttributes.ReflectedDefinitionAttribute -> Some g.attrib_ReflectedDefinitionAttribute + | _ -> None +#endif + /// Map a WellKnownILAttributes flag to its WellKnownEntityAttributes equivalent. /// Used for hybrid check sites that dispatch on IL vs F# metadata. let mapILFlagToEntityFlag (flag: WellKnownILAttributes) : WellKnownEntityAttributes = @@ -3993,34 +4006,10 @@ let TyconRefHasAttribute g m attribSpec tcref = let TyconRefHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownILAttributes) (tcref: TyconRef) : bool = match metadataOfTycon tcref.Deref with #if !NO_TYPEPROVIDERS - | ProvidedTypeMetadata info -> - let provAttribs = - info.ProvidedType.PApply((fun a -> (a :> IProvidedCustomAttributeProvider)), tcref.Range) - - let attrFullName = - match flag with - | WellKnownILAttributes.IsReadOnlyAttribute -> g.attrib_IsReadOnlyAttribute.TypeRef.FullName - | WellKnownILAttributes.IsByRefLikeAttribute -> - match g.attrib_IsByRefLikeAttribute_opt with - | Some attr -> attr.TypeRef.FullName - | None -> "" - | WellKnownILAttributes.ExtensionAttribute -> g.attrib_ExtensionAttribute.TypeRef.FullName - | WellKnownILAttributes.AllowNullLiteralAttribute -> g.attrib_AllowNullLiteralAttribute.TypeRef.FullName - | WellKnownILAttributes.AutoOpenAttribute -> g.attrib_AutoOpenAttribute.TypeRef.FullName - | WellKnownILAttributes.ReflectedDefinitionAttribute -> g.attrib_ReflectedDefinitionAttribute.TypeRef.FullName - | _ -> "" - - if attrFullName = "" then - false - else - provAttribs - .PUntaint( - (fun a -> - a - .GetAttributeConstructorArgs(provAttribs.TypeProvider.PUntaintNoFailure id, attrFullName)), - tcref.Range - ) - .IsSome + | ProvidedTypeMetadata _ -> + match mapILFlagToAttribInfo g flag with + | Some attribInfo -> TyconRefHasAttribute g tcref.Range attribInfo tcref + | None -> false #endif | ILTypeMetadata(TILObjectReprData(_, _, tdef)) -> tdef.HasWellKnownAttribute(g, flag) | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> From 2fe9d4225d7469e67a3bf5f70d7bce8b13861010 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Sat, 21 Feb 2026 06:29:38 +0100 Subject: [PATCH 10/71] Sprint 7: Fix isByrefLikeTyconRef to use name-based attribute matching Revert isByrefLikeTyconRef from TyconRefHasWellKnownAttribute (type-identity) back to TyconRefHasAttributeByName (name-based) to preserve RFC FS-1053 compatibility. User code can define its own IsByRefLikeAttribute, so this function must match by attribute name, not by type identity. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TypedTreeOps.fs | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 4df2b95bf02..93f08c64d7d 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -4060,17 +4060,20 @@ let isByrefTyconRef (g: TcGlobals) (tcref: TyconRef) = tyconRefEqOpt g g.system_RuntimeArgumentHandle_tcref tcref // See RFC FS-1053.md -let isByrefLikeTyconRef (g: TcGlobals) (m: range) (tcref: TyconRef) = - ignore m - tcref.CanDeref && - match tcref.TryIsByRefLike with - | ValueSome res -> res - | _ -> - let res = - isByrefTyconRef g tcref || - (isStructTyconRef tcref && TyconRefHasWellKnownAttribute g WellKnownILAttributes.IsByRefLikeAttribute tcref) - tcref.SetIsByRefLike res - res +// Must use name-based matching (not type-identity) because user code can define +// its own IsByRefLikeAttribute per RFC FS-1053. +let isByrefLikeTyconRef (g: TcGlobals) m (tcref: TyconRef) = + tcref.CanDeref + && match tcref.TryIsByRefLike with + | ValueSome res -> res + | _ -> + let res = + isByrefTyconRef g tcref + || (isStructTyconRef tcref + && TyconRefHasAttributeByName m tname_IsByRefLikeAttribute tcref) + + tcref.SetIsByRefLike res + res let isSpanLikeTyconRef g m tcref = isByrefLikeTyconRef g m tcref && From 5a99c7142bc16be15ec9f34957357d9cff26f792 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Sat, 21 Feb 2026 07:37:29 +0100 Subject: [PATCH 11/71] Sprint 7: Fix PostInferenceChecks IsByRefLike to use name-based matching per RFC FS-1053 The IsByRefLikeAttribute check in CheckEntityDefn was incorrectly changed to type-identity matching (TyconRefHasWellKnownAttribute) during Sprint 6. This breaks user-defined IsByRefLikeAttribute per RFC FS-1053. Reverted to name-based matching (TyconRefHasAttributeByName) for consistency with isByrefLikeTyconRef in TypedTreeOps.fs. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/PostInferenceChecks.fs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index e28f9bfe3af..719eec67ae5 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -2567,7 +2567,9 @@ let CheckEntityDefn cenv env (tycon: Entity) = errorR(Error(FSComp.SR.chkDuplicateMethodInheritedTypeWithSuffix nm, m)) - if TyconRefHasWellKnownAttribute g WellKnownILAttributes.IsByRefLikeAttribute tcref && not tycon.IsStructOrEnumTycon then + // Must use name-based matching (not type-identity) because user code can define + // its own IsByRefLikeAttribute per RFC FS-1053. + if TyconRefHasAttributeByName m tname_IsByRefLikeAttribute tcref && not tycon.IsStructOrEnumTycon then errorR(Error(FSComp.SR.tcByRefLikeNotStruct(), tycon.Range)) if TyconRefHasWellKnownAttribute g WellKnownILAttributes.IsReadOnlyAttribute tcref && not tycon.IsStructOrEnumTycon then From 0c9e88f6963d813b1dcabbe81e6b002a0592ea27 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 23 Feb 2026 21:30:57 +0100 Subject: [PATCH 12/71] Rewrite computeEntityWellKnownFlags with multi-level path dispatch Replace flat if/elif chain of 27 tyconRefEq comparisons with a two-phase dispatch: first check assembly identity (ccuEq), then array pattern match on the namespace path. User-defined attributes from unrelated assemblies are rejected in 1-2 cheap checks instead of 27 comparisons. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TypedTreeOps.fs | 148 ++++++++++++++----------- 1 file changed, 86 insertions(+), 62 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 93f08c64d7d..17db9b9e99d 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3720,68 +3720,92 @@ let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEnt for attrib in attribs do let (Attrib(tcref, _, _, _, _, _, _)) = attrib - if tyconRefEq g tcref g.attrib_RequireQualifiedAccessAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.RequireQualifiedAccessAttribute - elif tyconRefEq g tcref g.attrib_AutoOpenAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.AutoOpenAttribute - elif tyconRefEq g tcref g.attrib_AbstractClassAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.AbstractClassAttribute - elif tyconRefEq g tcref g.attrib_SealedAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.SealedAttribute - elif tyconRefEq g tcref g.attrib_NoEqualityAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.NoEqualityAttribute - elif tyconRefEq g tcref g.attrib_NoComparisonAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.NoComparisonAttribute - elif tyconRefEq g tcref g.attrib_StructuralEqualityAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.StructuralEqualityAttribute - elif tyconRefEq g tcref g.attrib_StructuralComparisonAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.StructuralComparisonAttribute - elif tyconRefEq g tcref g.attrib_CustomEqualityAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.CustomEqualityAttribute - elif tyconRefEq g tcref g.attrib_CustomComparisonAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.CustomComparisonAttribute - elif tyconRefEq g tcref g.attrib_ReferenceEqualityAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.ReferenceEqualityAttribute - elif tyconRefEq g tcref g.attrib_DefaultAugmentationAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.DefaultAugmentationAttribute - elif tyconRefEq g tcref g.attrib_CLIMutableAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.CLIMutableAttribute - elif tyconRefEq g tcref g.attrib_AutoSerializableAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.AutoSerializableAttribute - elif tyconRefEq g tcref g.attrib_StructLayoutAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.StructLayoutAttribute - elif - (match g.attrib_DllImportAttribute with - | Some a -> tyconRefEq g tcref a.TyconRef - | None -> false) - then - flags <- flags ||| WellKnownEntityAttributes.DllImportAttribute - elif tyconRefEq g tcref g.attrib_ReflectedDefinitionAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.ReflectedDefinitionAttribute - elif tyconRefEq g tcref g.attrib_GeneralizableValueAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.GeneralizableValueAttribute - elif tyconRefEq g tcref g.attrib_SkipLocalsInitAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.SkipLocalsInitAttribute - elif tyconRefEq g tcref g.attrib_DebuggerTypeProxyAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.DebuggerTypeProxyAttribute - elif tyconRefEq g tcref g.attrib_ComVisibleAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.ComVisibleAttribute - elif tyconRefEq g tcref g.attrib_IsReadOnlyAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.IsReadOnlyAttribute - elif - (match g.attrib_IsByRefLikeAttribute_opt with - | Some a -> tyconRefEq g tcref a.TyconRef - | None -> false) - then - flags <- flags ||| WellKnownEntityAttributes.IsByRefLikeAttribute - elif tyconRefEq g tcref g.attrib_ExtensionAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.ExtensionAttribute - elif tyconRefEq g tcref g.attrib_AttributeUsageAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.AttributeUsageAttribute - elif tyconRefEq g tcref g.attrib_WarnOnWithoutNullArgumentAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.WarnOnWithoutNullArgumentAttribute - elif tyconRefEq g tcref g.attrib_AllowNullLiteralAttribute.TyconRef then - flags <- flags ||| WellKnownEntityAttributes.AllowNullLiteralAttribute + // Resolve the path for this attribute's type. + // Non-local refs from FSharp.Core → ValueSome path + // Local refs when compilingFSharpCore → ValueSome path (via PublicPath) + // Everything else → ValueNone (system attrs handled inline, user attrs skipped) + let fsharpCorePath = + if not tcref.IsLocalRef then + let nlr = tcref.nlr + + if ccuEq nlr.Ccu g.fslibCcu then + ValueSome nlr.Path + else + // ── System / BCL assemblies ── + match nlr.Path with + | [| "System"; "Runtime"; "CompilerServices"; name |] -> + match name with + | "ExtensionAttribute" -> flags <- flags ||| WellKnownEntityAttributes.ExtensionAttribute + | "IsReadOnlyAttribute" -> flags <- flags ||| WellKnownEntityAttributes.IsReadOnlyAttribute + | "SkipLocalsInitAttribute" -> flags <- flags ||| WellKnownEntityAttributes.SkipLocalsInitAttribute + | "IsByRefLikeAttribute" -> flags <- flags ||| WellKnownEntityAttributes.IsByRefLikeAttribute + | _ -> () + + | [| "System"; "Runtime"; "InteropServices"; name |] -> + match name with + | "StructLayoutAttribute" -> flags <- flags ||| WellKnownEntityAttributes.StructLayoutAttribute + | "DllImportAttribute" -> flags <- flags ||| WellKnownEntityAttributes.DllImportAttribute + | "ComVisibleAttribute" -> flags <- flags ||| WellKnownEntityAttributes.ComVisibleAttribute + | _ -> () + + | [| "System"; "Diagnostics"; name |] -> + match name with + | "DebuggerTypeProxyAttribute" -> flags <- flags ||| WellKnownEntityAttributes.DebuggerTypeProxyAttribute + | _ -> () + + | [| "System"; name |] -> + match name with + | "AttributeUsageAttribute" -> flags <- flags ||| WellKnownEntityAttributes.AttributeUsageAttribute + | _ -> () + + | _ -> () + + ValueNone + elif g.compilingFSharpCore then + match tcref.Deref.PublicPath with + | Some(PubPath pp) -> ValueSome pp + | None -> ValueNone + else + ValueNone + + // ── FSharp.Core attributes (written once, used for both paths) ── + match fsharpCorePath with + | ValueSome path -> + match path with + | [| "Microsoft"; "FSharp"; "Core"; name |] -> + match name with + | "SealedAttribute" -> flags <- flags ||| WellKnownEntityAttributes.SealedAttribute + | "AbstractClassAttribute" -> flags <- flags ||| WellKnownEntityAttributes.AbstractClassAttribute + | "RequireQualifiedAccessAttribute" -> + flags <- flags ||| WellKnownEntityAttributes.RequireQualifiedAccessAttribute + | "AutoOpenAttribute" -> flags <- flags ||| WellKnownEntityAttributes.AutoOpenAttribute + | "NoEqualityAttribute" -> flags <- flags ||| WellKnownEntityAttributes.NoEqualityAttribute + | "NoComparisonAttribute" -> flags <- flags ||| WellKnownEntityAttributes.NoComparisonAttribute + | "StructuralEqualityAttribute" -> + flags <- flags ||| WellKnownEntityAttributes.StructuralEqualityAttribute + | "StructuralComparisonAttribute" -> + flags <- flags ||| WellKnownEntityAttributes.StructuralComparisonAttribute + | "CustomEqualityAttribute" -> flags <- flags ||| WellKnownEntityAttributes.CustomEqualityAttribute + | "CustomComparisonAttribute" -> + flags <- flags ||| WellKnownEntityAttributes.CustomComparisonAttribute + | "ReferenceEqualityAttribute" -> + flags <- flags ||| WellKnownEntityAttributes.ReferenceEqualityAttribute + | "DefaultAugmentationAttribute" -> + flags <- flags ||| WellKnownEntityAttributes.DefaultAugmentationAttribute + | "CLIMutableAttribute" -> flags <- flags ||| WellKnownEntityAttributes.CLIMutableAttribute + | "AutoSerializableAttribute" -> + flags <- flags ||| WellKnownEntityAttributes.AutoSerializableAttribute + | "ReflectedDefinitionAttribute" -> + flags <- flags ||| WellKnownEntityAttributes.ReflectedDefinitionAttribute + | "GeneralizableValueAttribute" -> + flags <- flags ||| WellKnownEntityAttributes.GeneralizableValueAttribute + | "AllowNullLiteralAttribute" -> + flags <- flags ||| WellKnownEntityAttributes.AllowNullLiteralAttribute + | "WarnOnWithoutNullArgumentAttribute" -> + flags <- flags ||| WellKnownEntityAttributes.WarnOnWithoutNullArgumentAttribute + | _ -> () + | _ -> () + | ValueNone -> () flags From 6e4ad5d5499d4d29bf6081e070d3054348b47df2 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 23 Feb 2026 22:08:30 +0100 Subject: [PATCH 13/71] Rewrite computeValWellKnownFlags with multi-level path dispatch MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Replace flat if/elif chain of tyconRefEq calls with two-phase assembly/path routing and array pattern matching, matching the approach used in computeEntityWellKnownFlags. User attributes are rejected in 1-2 cheap checks instead of O(N×K) comparisons. All 25 well-known val attributes are covered. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TypedTreeOps.fs | 147 +++++++++++++------------ 1 file changed, 77 insertions(+), 70 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 17db9b9e99d..d6b51df6f4b 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3864,76 +3864,83 @@ let computeValWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownValAtt for attrib in attribs do let (Attrib(tcref, _, _, _, _, _, _)) = attrib - if - (match g.attrib_DllImportAttribute with - | Some a -> tyconRefEq g tcref a.TyconRef - | None -> false) - then - flags <- flags ||| WellKnownValAttributes.DllImportAttribute - elif tyconRefEq g tcref g.attrib_EntryPointAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.EntryPointAttribute - elif tyconRefEq g tcref g.attrib_LiteralAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.LiteralAttribute - elif tyconRefEq g tcref g.attrib_ConditionalAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.ConditionalAttribute - elif tyconRefEq g tcref g.attrib_ReflectedDefinitionAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.ReflectedDefinitionAttribute - elif tyconRefEq g tcref g.attrib_RequiresExplicitTypeArgumentsAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.RequiresExplicitTypeArgumentsAttribute - elif tyconRefEq g tcref g.attrib_DefaultValueAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.DefaultValueAttribute - elif tyconRefEq g tcref g.attrib_SkipLocalsInitAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.SkipLocalsInitAttribute - elif - (match g.attrib_ThreadStaticAttribute with - | Some a -> tyconRefEq g tcref a.TyconRef - | None -> false) - then - flags <- flags ||| WellKnownValAttributes.ThreadStaticAttribute - elif - (match g.attrib_ContextStaticAttribute with - | Some a -> tyconRefEq g tcref a.TyconRef - | None -> false) - then - flags <- flags ||| WellKnownValAttributes.ContextStaticAttribute - elif tyconRefEq g tcref g.attrib_VolatileFieldAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.VolatileFieldAttribute - elif tyconRefEq g tcref g.attrib_NoDynamicInvocationAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.NoDynamicInvocationAttribute - elif tyconRefEq g tcref g.attrib_ExtensionAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.ExtensionAttribute - elif tyconRefEq g tcref g.attrib_OptionalArgumentAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.OptionalArgumentAttribute - elif tyconRefEq g tcref g.attrib_InAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.InAttribute - elif tyconRefEq g tcref g.attrib_OutAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.OutAttribute - elif tyconRefEq g tcref g.attrib_ParamArrayAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.ParamArrayAttribute - elif tyconRefEq g tcref g.attrib_CallerMemberNameAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.CallerMemberNameAttribute - elif tyconRefEq g tcref g.attrib_CallerFilePathAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.CallerFilePathAttribute - elif tyconRefEq g tcref g.attrib_CallerLineNumberAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.CallerLineNumberAttribute - elif - (match g.attrib_DefaultParameterValueAttribute with - | Some a -> tyconRefEq g tcref a.TyconRef - | None -> false) - then - flags <- flags ||| WellKnownValAttributes.DefaultParameterValueAttribute - elif tyconRefEq g tcref g.attrib_ProjectionParameterAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.ProjectionParameterAttribute - elif tyconRefEq g tcref g.attrib_InlineIfLambdaAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.InlineIfLambdaAttribute - elif - (match g.attrib_OptionalAttribute with - | Some a -> tyconRefEq g tcref a.TyconRef - | None -> false) - then - flags <- flags ||| WellKnownValAttributes.OptionalAttribute - elif tyconRefEq g tcref g.attrib_StructAttribute.TyconRef then - flags <- flags ||| WellKnownValAttributes.StructAttribute + let fsharpCorePath = + if not tcref.IsLocalRef then + let nlr = tcref.nlr + + if ccuEq nlr.Ccu g.fslibCcu then + ValueSome nlr.Path + else + // ── System / BCL assemblies ── + match nlr.Path with + | [| "System"; "Runtime"; "CompilerServices"; name |] -> + match name with + | "SkipLocalsInitAttribute" -> flags <- flags ||| WellKnownValAttributes.SkipLocalsInitAttribute + | "ExtensionAttribute" -> flags <- flags ||| WellKnownValAttributes.ExtensionAttribute + | "CallerMemberNameAttribute" -> + flags <- flags ||| WellKnownValAttributes.CallerMemberNameAttribute + | "CallerFilePathAttribute" -> flags <- flags ||| WellKnownValAttributes.CallerFilePathAttribute + | "CallerLineNumberAttribute" -> + flags <- flags ||| WellKnownValAttributes.CallerLineNumberAttribute + | _ -> () + + | [| "System"; "Runtime"; "InteropServices"; name |] -> + match name with + | "DllImportAttribute" -> flags <- flags ||| WellKnownValAttributes.DllImportAttribute + | "InAttribute" -> flags <- flags ||| WellKnownValAttributes.InAttribute + | "OutAttribute" -> flags <- flags ||| WellKnownValAttributes.OutAttribute + | "DefaultParameterValueAttribute" -> + flags <- flags ||| WellKnownValAttributes.DefaultParameterValueAttribute + | "OptionalAttribute" -> flags <- flags ||| WellKnownValAttributes.OptionalAttribute + | _ -> () + + | [| "System"; "Diagnostics"; name |] -> + match name with + | "ConditionalAttribute" -> flags <- flags ||| WellKnownValAttributes.ConditionalAttribute + | _ -> () + + | [| "System"; name |] -> + match name with + | "ThreadStaticAttribute" -> flags <- flags ||| WellKnownValAttributes.ThreadStaticAttribute + | "ContextStaticAttribute" -> flags <- flags ||| WellKnownValAttributes.ContextStaticAttribute + | "ParamArrayAttribute" -> flags <- flags ||| WellKnownValAttributes.ParamArrayAttribute + | _ -> () + + | _ -> () + + ValueNone + elif g.compilingFSharpCore then + match tcref.Deref.PublicPath with + | Some(PubPath pp) -> ValueSome pp + | None -> ValueNone + else + ValueNone + + // ── FSharp.Core attributes ── + match fsharpCorePath with + | ValueSome path -> + match path with + | [| "Microsoft"; "FSharp"; "Core"; name |] -> + match name with + | "EntryPointAttribute" -> flags <- flags ||| WellKnownValAttributes.EntryPointAttribute + | "LiteralAttribute" -> flags <- flags ||| WellKnownValAttributes.LiteralAttribute + | "ReflectedDefinitionAttribute" -> + flags <- flags ||| WellKnownValAttributes.ReflectedDefinitionAttribute + | "RequiresExplicitTypeArgumentsAttribute" -> + flags <- flags ||| WellKnownValAttributes.RequiresExplicitTypeArgumentsAttribute + | "DefaultValueAttribute" -> flags <- flags ||| WellKnownValAttributes.DefaultValueAttribute + | "VolatileFieldAttribute" -> flags <- flags ||| WellKnownValAttributes.VolatileFieldAttribute + | "NoDynamicInvocationAttribute" -> + flags <- flags ||| WellKnownValAttributes.NoDynamicInvocationAttribute + | "OptionalArgumentAttribute" -> + flags <- flags ||| WellKnownValAttributes.OptionalArgumentAttribute + | "ProjectionParameterAttribute" -> + flags <- flags ||| WellKnownValAttributes.ProjectionParameterAttribute + | "InlineIfLambdaAttribute" -> flags <- flags ||| WellKnownValAttributes.InlineIfLambdaAttribute + | "StructAttribute" -> flags <- flags ||| WellKnownValAttributes.StructAttribute + | _ -> () + | _ -> () + | ValueNone -> () flags From 7a4250384a7089f14f55c93887a01da45db18066 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 23 Feb 2026 23:00:15 +0100 Subject: [PATCH 14/71] Rewrite computeILWellKnownFlags with prefix + string match dispatch Replace flat if/elif chain of nameMatch calls against 16 AttribInfo references with a prefix-based dispatch on ILTypeRef.Name. User-defined attributes bail out after 1-2 prefix checks instead of scanning all 16+ comparisons. Key changes: - Remove 16 AttribInfo extractions from TcGlobals at function top - Remove inline nameMatch helper - Group by StartsWith prefix: System.Runtime.CompilerServices (13), Microsoft.FSharp.Core (4), then remaining (3) - Cover SetsRequiredMembersAttribute from both CompilerServices and CodeAnalysis namespaces Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TypedTreeOps.fs | 119 +++++++++++-------------- 1 file changed, 53 insertions(+), 66 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index d6b51df6f4b..00d434e8b08 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3618,78 +3618,65 @@ let IsILAttrib (AttribInfo (builtInAttrRef, _)) attr = isILAttrib builtInAttrRe /// Compute well-known attribute flags for an ILAttributes collection. /// This is the 'compute' callback passed to ILAttributesStored.HasWellKnownAttribute. let computeILWellKnownFlags (g: TcGlobals) (attrs: ILAttributes) : WellKnownILAttributes = + ignore g let mutable flags = WellKnownILAttributes.None - let (AttribInfo(isReadOnlyRef, _)) = g.attrib_IsReadOnlyAttribute - let (AttribInfo(isUnmanagedRef, _)) = g.attrib_IsUnmanagedAttribute - let (AttribInfo(extensionRef, _)) = g.attrib_ExtensionAttribute - let (AttribInfo(paramArrayRef, _)) = g.attrib_ParamArrayAttribute - let (AttribInfo(allowNullLiteralRef, _)) = g.attrib_AllowNullLiteralAttribute - let (AttribInfo(reflectedDefRef, _)) = g.attrib_ReflectedDefinitionAttribute - let (AttribInfo(autoOpenRef, _)) = g.attrib_AutoOpenAttribute - let (AttribInfo(internalsVisibleToRef, _)) = g.attrib_InternalsVisibleToAttribute - let (AttribInfo(callerMemberNameRef, _)) = g.attrib_CallerMemberNameAttribute - let (AttribInfo(callerFilePathRef, _)) = g.attrib_CallerFilePathAttribute - let (AttribInfo(callerLineNumberRef, _)) = g.attrib_CallerLineNumberAttribute - let (AttribInfo(defaultMemberRef, _)) = g.attrib_DefaultMemberAttribute - let (AttribInfo(setsRequiredMembersRef, _)) = g.attrib_SetsRequiredMembersAttribute - let (AttribInfo(requiresLocationRef, _)) = g.attrib_RequiresLocationAttribute - let (AttribInfo(nullableRef, _)) = g.attrib_NullableAttribute - let (AttribInfo(noEagerConstraintRef, _)) = g.attrib_NoEagerConstraintApplicationAttribute - - // Compare by name and enclosing only (not scope), matching isILAttrib semantics. - // BCL reference assemblies may use ILScopeRef.Local while TcGlobals uses ILScopeRef.Assembly. - let inline nameMatch (a: ILTypeRef) (b: ILTypeRef) = - a.Name = b.Name && a.Enclosing = b.Enclosing - for attr in attrs.AsArray() do let atref = attr.Method.DeclaringType.TypeSpec.TypeRef - if nameMatch atref isReadOnlyRef then - flags <- flags ||| WellKnownILAttributes.IsReadOnlyAttribute - elif nameMatch atref isUnmanagedRef then - flags <- flags ||| WellKnownILAttributes.IsUnmanagedAttribute - elif nameMatch atref extensionRef then - flags <- flags ||| WellKnownILAttributes.ExtensionAttribute - elif nameMatch atref paramArrayRef then - flags <- flags ||| WellKnownILAttributes.ParamArrayAttribute - elif nameMatch atref allowNullLiteralRef then - flags <- flags ||| WellKnownILAttributes.AllowNullLiteralAttribute - elif nameMatch atref reflectedDefRef then - flags <- flags ||| WellKnownILAttributes.ReflectedDefinitionAttribute - elif nameMatch atref autoOpenRef then - flags <- flags ||| WellKnownILAttributes.AutoOpenAttribute - elif nameMatch atref internalsVisibleToRef then - flags <- flags ||| WellKnownILAttributes.InternalsVisibleToAttribute - elif nameMatch atref callerMemberNameRef then - flags <- flags ||| WellKnownILAttributes.CallerMemberNameAttribute - elif nameMatch atref callerFilePathRef then - flags <- flags ||| WellKnownILAttributes.CallerFilePathAttribute - elif nameMatch atref callerLineNumberRef then - flags <- flags ||| WellKnownILAttributes.CallerLineNumberAttribute - elif nameMatch atref defaultMemberRef then - flags <- flags ||| WellKnownILAttributes.DefaultMemberAttribute - elif nameMatch atref setsRequiredMembersRef then - flags <- flags ||| WellKnownILAttributes.SetsRequiredMembersAttribute - elif nameMatch atref requiresLocationRef then - flags <- flags ||| WellKnownILAttributes.RequiresLocationAttribute - elif nameMatch atref nullableRef then - flags <- flags ||| WellKnownILAttributes.NullableAttribute - elif nameMatch atref noEagerConstraintRef then - flags <- flags ||| WellKnownILAttributes.NoEagerConstraintApplicationAttribute - else - match g.attrib_IsByRefLikeAttribute_opt with - | Some(AttribInfo(r, _)) when nameMatch atref r -> - flags <- flags ||| WellKnownILAttributes.IsByRefLikeAttribute - | _ -> - match g.attrib_IDispatchConstantAttribute with - | Some(AttribInfo(r, _)) when nameMatch atref r -> + if atref.Enclosing.IsEmpty then + let name = atref.Name + + if name.StartsWith("System.Runtime.CompilerServices.") then + match name with + | "System.Runtime.CompilerServices.IsReadOnlyAttribute" -> + flags <- flags ||| WellKnownILAttributes.IsReadOnlyAttribute + | "System.Runtime.CompilerServices.IsUnmanagedAttribute" -> + flags <- flags ||| WellKnownILAttributes.IsUnmanagedAttribute + | "System.Runtime.CompilerServices.ExtensionAttribute" -> + flags <- flags ||| WellKnownILAttributes.ExtensionAttribute + | "System.Runtime.CompilerServices.IsByRefLikeAttribute" -> + flags <- flags ||| WellKnownILAttributes.IsByRefLikeAttribute + | "System.Runtime.CompilerServices.InternalsVisibleToAttribute" -> + flags <- flags ||| WellKnownILAttributes.InternalsVisibleToAttribute + | "System.Runtime.CompilerServices.CallerMemberNameAttribute" -> + flags <- flags ||| WellKnownILAttributes.CallerMemberNameAttribute + | "System.Runtime.CompilerServices.CallerFilePathAttribute" -> + flags <- flags ||| WellKnownILAttributes.CallerFilePathAttribute + | "System.Runtime.CompilerServices.CallerLineNumberAttribute" -> + flags <- flags ||| WellKnownILAttributes.CallerLineNumberAttribute + | "System.Runtime.CompilerServices.RequiresLocationAttribute" -> + flags <- flags ||| WellKnownILAttributes.RequiresLocationAttribute + | "System.Runtime.CompilerServices.NullableAttribute" -> + flags <- flags ||| WellKnownILAttributes.NullableAttribute + | "System.Runtime.CompilerServices.IDispatchConstantAttribute" -> flags <- flags ||| WellKnownILAttributes.IDispatchConstantAttribute - | _ -> - match g.attrib_IUnknownConstantAttribute with - | Some(AttribInfo(r, _)) when nameMatch atref r -> - flags <- flags ||| WellKnownILAttributes.IUnknownConstantAttribute - | _ -> () + | "System.Runtime.CompilerServices.IUnknownConstantAttribute" -> + flags <- flags ||| WellKnownILAttributes.IUnknownConstantAttribute + | "System.Runtime.CompilerServices.SetsRequiredMembersAttribute" -> + flags <- flags ||| WellKnownILAttributes.SetsRequiredMembersAttribute + | _ -> () + + elif name.StartsWith("Microsoft.FSharp.Core.") then + match name with + | "Microsoft.FSharp.Core.AllowNullLiteralAttribute" -> + flags <- flags ||| WellKnownILAttributes.AllowNullLiteralAttribute + | "Microsoft.FSharp.Core.ReflectedDefinitionAttribute" -> + flags <- flags ||| WellKnownILAttributes.ReflectedDefinitionAttribute + | "Microsoft.FSharp.Core.AutoOpenAttribute" -> + flags <- flags ||| WellKnownILAttributes.AutoOpenAttribute + | "Microsoft.FSharp.Core.CompilerServices.NoEagerConstraintApplicationAttribute" -> + flags <- flags ||| WellKnownILAttributes.NoEagerConstraintApplicationAttribute + | _ -> () + + else + match name with + | "System.ParamArrayAttribute" -> flags <- flags ||| WellKnownILAttributes.ParamArrayAttribute + | "System.Reflection.DefaultMemberAttribute" -> + flags <- flags ||| WellKnownILAttributes.DefaultMemberAttribute + | "System.Diagnostics.CodeAnalysis.SetsRequiredMembersAttribute" -> + flags <- flags ||| WellKnownILAttributes.SetsRequiredMembersAttribute + | _ -> () flags From 59b64c8c7ee298f7f3e63783f75160e309b41198 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 25 Feb 2026 13:29:51 +0100 Subject: [PATCH 15/71] Migrate getAugmentationAttribs to cached WellKnownEntityAttributes flags Replace 7 TryFindFSharpBoolAttribute linear scans with cached EntityHasWellKnownAttribute lookups. Update all pattern match sites in CheckAugmentationAttribs, TyconIsCandidateForAugmentationWithCompare, and TyconIsCandidateForAugmentationWithEquals from bool option to bool. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../Checking/AugmentWithHashCompare.fs | 72 +++++++++---------- 1 file changed, 36 insertions(+), 36 deletions(-) diff --git a/src/Compiler/Checking/AugmentWithHashCompare.fs b/src/Compiler/Checking/AugmentWithHashCompare.fs index 1af54769655..96d42f18fc0 100644 --- a/src/Compiler/Checking/AugmentWithHashCompare.fs +++ b/src/Compiler/Checking/AugmentWithHashCompare.fs @@ -1032,13 +1032,13 @@ let canBeAugmentedWithCompare g (tycon: Tycon) = let getAugmentationAttribs g (tycon: Tycon) = canBeAugmentedWithEquals g tycon, canBeAugmentedWithCompare g tycon, - TryFindFSharpBoolAttribute g g.attrib_NoEqualityAttribute tycon.Attribs, - TryFindFSharpBoolAttribute g g.attrib_CustomEqualityAttribute tycon.Attribs, - TryFindFSharpBoolAttribute g g.attrib_ReferenceEqualityAttribute tycon.Attribs, - TryFindFSharpBoolAttribute g g.attrib_StructuralEqualityAttribute tycon.Attribs, - TryFindFSharpBoolAttribute g g.attrib_NoComparisonAttribute tycon.Attribs, - TryFindFSharpBoolAttribute g g.attrib_CustomComparisonAttribute tycon.Attribs, - TryFindFSharpBoolAttribute g g.attrib_StructuralComparisonAttribute tycon.Attribs + EntityHasWellKnownAttribute g WellKnownEntityAttributes.NoEqualityAttribute tycon, + EntityHasWellKnownAttribute g WellKnownEntityAttributes.CustomEqualityAttribute tycon, + EntityHasWellKnownAttribute g WellKnownEntityAttributes.ReferenceEqualityAttribute tycon, + EntityHasWellKnownAttribute g WellKnownEntityAttributes.StructuralEqualityAttribute tycon, + EntityHasWellKnownAttribute g WellKnownEntityAttributes.NoComparisonAttribute tycon, + EntityHasWellKnownAttribute g WellKnownEntityAttributes.CustomComparisonAttribute tycon, + EntityHasWellKnownAttribute g WellKnownEntityAttributes.StructuralComparisonAttribute tycon [] type EqualityWithComparerAugmentation = @@ -1058,64 +1058,64 @@ let CheckAugmentationAttribs isImplementation g amap (tycon: Tycon) = // THESE ARE THE LEGITIMATE CASES // [< >] on anything - | _, _, None, None, None, None, None, None, None + | _, _, false, false, false, false, false, false, false // [] on union/record/struct - | true, _, None, Some true, None, None, None, Some true, None + | true, _, false, true, false, false, false, true, false // [] on union/record/struct - | true, _, None, Some true, None, None, Some true, None, None -> () + | true, _, false, true, false, false, true, false, false -> () // [] on union/record/struct - | true, _, None, None, Some true, None, Some true, None, None + | true, _, false, false, true, false, true, false, false // [] on union/record/struct - | true, _, None, None, Some true, None, None, None, None -> + | true, _, false, false, true, false, false, false, false -> if isTrueFSharpStructTycon g tycon then errorR (Error(FSComp.SR.augNoRefEqualsOnStruct (), m)) else () // [] on union/record/struct - | true, true, None, None, None, Some true, None, None, Some true + | true, true, false, false, false, true, false, false, true // [] - | true, _, None, None, None, Some true, Some true, None, None + | true, _, false, false, false, true, true, false, false // [] - | true, _, None, None, None, Some true, None, Some true, None + | true, _, false, false, false, true, false, true, false // [] on anything - | _, _, None, None, None, None, Some true, None, None + | _, _, false, false, false, false, true, false, false // [] on anything - | _, _, Some true, None, None, None, Some true, None, None -> () + | _, _, true, false, false, false, true, false, false -> () // THESE ARE THE ERROR CASES // [] - | _, _, Some true, _, _, _, None, _, _ -> errorR (Error(FSComp.SR.augNoEqualityNeedsNoComparison (), m)) + | _, _, true, _, _, _, false, _, _ -> errorR (Error(FSComp.SR.augNoEqualityNeedsNoComparison (), m)) // [] - | true, true, _, _, _, None, _, _, Some true -> errorR (Error(FSComp.SR.augStructCompNeedsStructEquality (), m)) + | true, true, _, _, _, false, _, _, true -> errorR (Error(FSComp.SR.augStructCompNeedsStructEquality (), m)) // [] - | true, _, _, _, _, Some true, None, _, None -> errorR (Error(FSComp.SR.augStructEqNeedsNoCompOrStructComp (), m)) + | true, _, _, _, _, true, false, _, false -> errorR (Error(FSComp.SR.augStructEqNeedsNoCompOrStructComp (), m)) // [] - | true, _, _, Some true, _, _, None, None, _ -> errorR (Error(FSComp.SR.augCustomEqNeedsNoCompOrCustomComp (), m)) + | true, _, _, true, _, _, false, false, _ -> errorR (Error(FSComp.SR.augCustomEqNeedsNoCompOrCustomComp (), m)) // [] - | true, _, _, _, Some true, Some true, _, _, _ + | true, _, _, _, true, true, _, _, _ // [] - | true, _, _, _, Some true, _, _, _, Some true -> errorR (Error(FSComp.SR.augTypeCantHaveRefEqAndStructAttrs (), m)) + | true, _, _, _, true, _, _, _, true -> errorR (Error(FSComp.SR.augTypeCantHaveRefEqAndStructAttrs (), m)) // non augmented type, [] // non augmented type, [] // non augmented type, [] - | false, _, _, _, Some true, _, _, _, _ - | false, _, _, _, _, Some true, _, _, _ - | false, _, _, _, _, _, _, _, Some true -> errorR (Error(FSComp.SR.augOnlyCertainTypesCanHaveAttrs (), m)) + | false, _, _, _, true, _, _, _, _ + | false, _, _, _, _, true, _, _, _ + | false, _, _, _, _, _, _, _, true -> errorR (Error(FSComp.SR.augOnlyCertainTypesCanHaveAttrs (), m)) // All other cases | _ -> errorR (Error(FSComp.SR.augInvalidAttrs (), m)) @@ -1138,21 +1138,21 @@ let CheckAugmentationAttribs isImplementation g amap (tycon: Tycon) = match attribs with // [] + any equality semantics - | _, _, Some true, _, _, _, _, _, _ when (hasExplicitEquals || hasExplicitGenericEquals) -> + | _, _, true, _, _, _, _, _, _ when (hasExplicitEquals || hasExplicitGenericEquals) -> warning (Error(FSComp.SR.augNoEqNeedsNoObjEquals (), m)) // [] + any comparison semantics - | _, _, _, _, _, _, Some true, _, _ when (hasExplicitICompare || hasExplicitIGenericCompare) -> + | _, _, _, _, _, _, true, _, _ when (hasExplicitICompare || hasExplicitIGenericCompare) -> warning (Error(FSComp.SR.augNoCompCantImpIComp (), m)) // [] + no explicit override Object.Equals + no explicit IStructuralEquatable - | _, _, _, Some true, _, _, _, _, _ when isImplementation && not hasExplicitEquals && not hasExplicitGenericEquals -> + | _, _, _, true, _, _, _, _, _ when isImplementation && not hasExplicitEquals && not hasExplicitGenericEquals -> errorR (Error(FSComp.SR.augCustomEqNeedsObjEquals (), m)) // [] + no explicit IComparable + no explicit IStructuralComparable - | _, _, _, _, _, _, _, Some true, _ when isImplementation && not hasExplicitICompare && not hasExplicitIGenericCompare -> + | _, _, _, _, _, _, _, true, _ when isImplementation && not hasExplicitICompare && not hasExplicitIGenericCompare -> errorR (Error(FSComp.SR.augCustomCompareNeedsIComp (), m)) // [] + any equality semantics - | _, _, _, _, Some true, _, _, _, _ when (hasExplicitEquals || hasExplicitIGenericCompare) -> + | _, _, _, _, true, _, _, _, _ when (hasExplicitEquals || hasExplicitIGenericCompare) -> errorR (Error(FSComp.SR.augRefEqCantHaveObjEquals (), m)) | _ -> () @@ -1165,11 +1165,11 @@ let TyconIsCandidateForAugmentationWithCompare (g: TcGlobals) (tycon: Tycon) = && not (isByrefLikeTyconRef g tycon.Range (mkLocalTyconRef tycon)) && match getAugmentationAttribs g tycon with // [< >] - | true, true, None, None, None, None, None, None, None + | true, true, false, false, false, false, false, false, false // [] - | true, true, None, None, None, Some true, None, None, Some true + | true, true, false, false, false, true, false, false, true // [] - | true, true, None, None, None, None, None, None, Some true -> true + | true, true, false, false, false, false, false, false, true -> true // other cases | _ -> false @@ -1183,10 +1183,10 @@ let TyconIsCandidateForAugmentationWithEquals (g: TcGlobals) (tycon: Tycon) = match getAugmentationAttribs g tycon with // [< >] - | true, _, None, None, None, None, _, _, _ + | true, _, false, false, false, false, _, _, _ // [] // [] - | true, _, None, None, None, Some true, _, _, _ -> true + | true, _, false, false, false, true, _, _, _ -> true // other cases | _ -> false From af7db93b36dbfbdcf582bf8e6c799f0bcc407810 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 25 Feb 2026 14:13:18 +0100 Subject: [PATCH 16/71] Migrate remaining existence-only attribute call sites to cached flags Replace TryFindFSharpBoolAttribute/HasFSharpAttribute/TryFindFSharpAttribute calls with EntityHasWellKnownAttribute/ValHasWellKnownAttribute at 10 sites: - CheckDeclarations.fs: StructuralComparison, StructuralEquality - NameResolution.fs: AutoOpen (CanAutoOpenTyconRef, module auto-open) - Optimizer.fs: CLIMutable - IlxGen.fs: CLIMutable, ComVisible (fast negative guard), LiteralAttribute, EntryPoint - fsi.fs: EntryPoint (fast negative guard) GeneralizableValueAttribute site left as-is (enum case is on Entity, not Val). ComVisible uses conservative fast negative guard to preserve exact semantics. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/CheckDeclarations.fs | 33 +++++++++------------- src/Compiler/Checking/NameResolution.fs | 4 +-- src/Compiler/CodeGen/IlxGen.fs | 18 ++++++------ src/Compiler/Interactive/fsi.fs | 9 ++++-- src/Compiler/Optimize/Optimizer.fs | 6 ++-- 5 files changed, 33 insertions(+), 37 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index c93f01f38bb..9456351b9be 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -2200,8 +2200,7 @@ module TyconConstraintInference = // If the type was excluded, say why if not res then - match TryFindFSharpBoolAttribute g g.attrib_StructuralComparisonAttribute tycon.Attribs with - | Some true -> + if EntityHasWellKnownAttribute g WellKnownEntityAttributes.StructuralComparisonAttribute tycon then match structuralTypes |> List.tryFind (fst >> checkIfFieldTypeSupportsComparison tycon >> not) with | None -> assert false @@ -2211,10 +2210,7 @@ module TyconConstraintInference = errorR(Error(FSComp.SR.tcStructuralComparisonNotSatisfied1(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty), tycon.Range)) else errorR(Error(FSComp.SR.tcStructuralComparisonNotSatisfied2(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty), tycon.Range)) - | Some false -> - () - - | None -> + else match structuralTypes |> List.tryFind (fst >> checkIfFieldTypeSupportsComparison tycon >> not) with | None -> assert false @@ -2326,8 +2322,7 @@ module TyconConstraintInference = // If the type was excluded, say why if not res then - match TryFindFSharpBoolAttribute g g.attrib_StructuralEqualityAttribute tycon.Attribs with - | Some true -> + if EntityHasWellKnownAttribute g WellKnownEntityAttributes.StructuralEqualityAttribute tycon then if AugmentTypeDefinitions.TyconIsCandidateForAugmentationWithEquals g tycon then match structuralTypes |> List.tryFind (fst >> checkIfFieldTypeSupportsEquality tycon >> not) with | None -> @@ -2338,11 +2333,7 @@ module TyconConstraintInference = errorR(Error(FSComp.SR.tcStructuralEqualityNotSatisfied1(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty), tycon.Range)) else errorR(Error(FSComp.SR.tcStructuralEqualityNotSatisfied2(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty), tycon.Range)) - else - () - | Some false -> - () - | None -> + else if AugmentTypeDefinitions.TyconIsCandidateForAugmentationWithEquals g tycon then match structuralTypes |> List.tryFind (fst >> checkIfFieldTypeSupportsEquality tycon >> not) with | None -> @@ -2860,12 +2851,13 @@ module EstablishTypeDefinitionCores = // 'Check' the attributes. We return the results to avoid having to re-check them in all other phases. // Allow failure of constructor resolution because Vals for members in the same recursive group are not yet available let attrs, getFinalAttrs = TcAttributesCanFail cenv envinner AttributeTargets.TyconDecl synAttrs + let entityFlags = computeEntityWellKnownFlags g attrs let hasMeasureAttr = HasFSharpAttribute g g.attrib_MeasureAttribute attrs let hasStructAttr = HasFSharpAttribute g g.attrib_StructAttribute attrs - let hasCLIMutable = HasFSharpAttribute g g.attrib_CLIMutableAttribute attrs - let hasAllowNullLiteralAttr = HasFSharpAttribute g g.attrib_AllowNullLiteralAttribute attrs - let hasSealedAttr = HasFSharpAttribute g g.attrib_SealedAttribute attrs - let structLayoutAttr = HasFSharpAttribute g g.attrib_StructLayoutAttribute attrs + let hasCLIMutable = entityFlags &&& WellKnownEntityAttributes.CLIMutableAttribute <> WellKnownEntityAttributes.None + let hasAllowNullLiteralAttr = entityFlags &&& WellKnownEntityAttributes.AllowNullLiteralAttribute <> WellKnownEntityAttributes.None + let hasSealedAttr = entityFlags &&& WellKnownEntityAttributes.SealedAttribute <> WellKnownEntityAttributes.None + let structLayoutAttr = entityFlags &&& WellKnownEntityAttributes.StructLayoutAttribute <> WellKnownEntityAttributes.None // We want to keep these special attributes treatment and avoid having two errors for the same attribute. let reportAttributeTargetsErrors = @@ -2883,7 +2875,7 @@ module EstablishTypeDefinitionCores = | SynTypeDefnSimpleRepr.Record _ | TyconCoreAbbrevThatIsReallyAUnion (hasMeasureAttr, envinner, id) _ | SynTypeDefnSimpleRepr.Union _ -> - HasFSharpAttribute g g.attrib_StructAttribute attrs + hasStructAttr | _ -> false @@ -3402,7 +3394,8 @@ module EstablishTypeDefinitionCores = let innerParent = Parent thisTyconRef let thisTyInst, thisTy = generalizeTyconRef g thisTyconRef - let hasAbstractAttr = HasFSharpAttribute g g.attrib_AbstractClassAttribute attrs + let entityFlags = computeEntityWellKnownFlags g attrs + let hasAbstractAttr = entityFlags &&& WellKnownEntityAttributes.AbstractClassAttribute <> WellKnownEntityAttributes.None let hasSealedAttr = // The special case is needed for 'unit' because the 'Sealed' attribute is not yet available when this type is defined. if g.compilingFSharpCore && id.idText = "Unit" then @@ -3421,7 +3414,7 @@ module EstablishTypeDefinitionCores = if hasAbstractAttr then tycon.TypeContents.tcaug_abstract <- true - tycon.entity_attribs <- WellKnownEntityAttribs.Create(attrs) + tycon.entity_attribs <- WellKnownEntityAttribs.CreateWithFlags(attrs, entityFlags) let noAbstractClassAttributeCheck() = if hasAbstractAttr then errorR (Error(FSComp.SR.tcOnlyClassesCanHaveAbstract(), m)) diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 21aaa7bd57f..d5528b43fb2 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -1314,7 +1314,7 @@ and private AddStaticPartsOfTyconRefToNameEnv bulkAddMode ownDefinition g amap m and private CanAutoOpenTyconRef (g: TcGlobals) m (tcref: TyconRef) = g.langVersion.SupportsFeature LanguageFeature.OpenTypeDeclaration && not tcref.IsILTycon && - TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute tcref.Attribs = Some true && + EntityHasWellKnownAttribute g WellKnownEntityAttributes.AutoOpenAttribute tcref.Deref && tcref.Typars(m) |> List.isEmpty /// Add any implied contents of a type definition to the environment. @@ -1437,7 +1437,7 @@ let rec AddModuleOrNamespaceRefsToNameEnv g amap m root ad nenv (modrefs: Module let nenv = (nenv, modrefs) ||> List.fold (fun nenv modref -> - if modref.IsModule && TryFindFSharpBoolAttribute g g.attrib_AutoOpenAttribute modref.Attribs = Some true then + if modref.IsModule && EntityHasWellKnownAttribute g WellKnownEntityAttributes.AutoOpenAttribute modref.Deref then AddModuleOrNamespaceContentsToNameEnv g amap ad m false nenv modref else nenv) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index a3ce2509cf4..30acae4ff6a 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -791,7 +791,7 @@ and ComputeUnionHasHelpers g (tcref: TyconRef) = elif tyconRefEq g tcref g.option_tcr_canon then SpecialFSharpOptionHelpers else - match TryFindFSharpAttribute g g.attrib_DefaultAugmentationAttribute tcref.Attribs with + match TryFindFSharpAttribute g g.attrib_DefaultAugmentationAttribute tcref.Attribs with // TODO: WELLKNOWN_ATTRIB - bool extraction | Some(Attrib(_, _, [ AttribBoolArg b ], _, _, _, _)) -> if b then AllHelpers else NoHelpers | Some(Attrib(_, _, _, _, _, _, m)) -> errorR (Error(FSComp.SR.ilDefaultAugmentationAttributeCouldNotBeDecoded (), m)) @@ -1531,10 +1531,9 @@ let ComputeStorageForFSharpValue cenv cloc optIntraAssemblyInfo optShadowLocal i GenType cenv m TypeReprEnv.Empty returnTy (* TypeReprEnv.Empty ok: not a field in a generic class *) let ilTyForProperty = mkILTyForCompLoc cloc - let attribs = vspec.Attribs let hasLiteralAttr = - HasFSharpAttribute cenv.g cenv.g.attrib_LiteralAttribute attribs + ValHasWellKnownAttribute cenv.g WellKnownValAttributes.LiteralAttribute vspec let ilTypeRefForProperty = ilTyForProperty.TypeRef @@ -9305,7 +9304,7 @@ and GenMethodForBinding // on the attribute. Older compilers let bodyExpr = let attr = - TryFindFSharpBoolAttributeAssumeFalse cenv.g cenv.g.attrib_NoDynamicInvocationAttribute v.Attribs + TryFindFSharpBoolAttributeAssumeFalse cenv.g cenv.g.attrib_NoDynamicInvocationAttribute v.Attribs // TODO: WELLKNOWN_ATTRIB if (not generateWitnessArgs && attr.IsSome) @@ -9613,7 +9612,7 @@ and GenMethodForBinding mdef // Does the function have an explicit [] attribute? - let isExplicitEntryPoint = HasFSharpAttribute g g.attrib_EntryPointAttribute attrs + let isExplicitEntryPoint = ValHasWellKnownAttribute g WellKnownValAttributes.EntryPointAttribute v let mdef = mdef @@ -11084,7 +11083,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option // Compute a bunch of useful things for each field let isCLIMutable = - (TryFindFSharpBoolAttribute g g.attrib_CLIMutableAttribute tycon.Attribs = Some true) + (EntityHasWellKnownAttribute g WellKnownEntityAttributes.CLIMutableAttribute tycon) let fieldSummaries = @@ -11426,7 +11425,8 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option if not isStructRecord && (isCLIMutable - || (TryFindFSharpBoolAttribute g g.attrib_ComVisibleAttribute tycon.Attribs = Some true)) + || (EntityHasWellKnownAttribute g WellKnownEntityAttributes.ComVisibleAttribute tycon + && TryFindFSharpBoolAttribute g g.attrib_ComVisibleAttribute tycon.Attribs = Some true)) then yield mkILSimpleStorageCtor (Some g.ilg.typ_Object.TypeSpec, ilThisTy, [], [], reprAccess, None, eenv.imports) @@ -11483,7 +11483,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option let tdef, tdefDiscards = let isSerializable = - (TryFindFSharpBoolAttribute g g.attrib_AutoSerializableAttribute tycon.Attribs + (TryFindFSharpBoolAttribute g g.attrib_AutoSerializableAttribute tycon.Attribs // TODO: WELLKNOWN_ATTRIB <> Some false) match tycon.TypeReprInfo with @@ -11566,7 +11566,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option tdef let tdLayout, tdEncoding = - match TryFindFSharpAttribute g g.attrib_StructLayoutAttribute tycon.Attribs with + match TryFindFSharpAttribute g g.attrib_StructLayoutAttribute tycon.Attribs with // TODO: WELLKNOWN_ATTRIB - value extraction | Some(Attrib(_, _, [ AttribInt32Arg layoutKind ], namedArgs, _, _, _)) -> let decoder = AttributeDecoder namedArgs let ilPack = decoder.FindInt32 "Pack" 0x0 diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index e807af5bf6f..dc78c5b82e3 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -1677,7 +1677,7 @@ let internal mkBoundValueTypedImpl tcGlobals m moduleName name ty = [], [], { - Attribs = WellKnownValAttribs.Create([]) + Attribs = WellKnownValAttribs.Empty Name = None OtherRange = None } @@ -2203,8 +2203,11 @@ type internal FsiDynamicCompiler /// Check FSI entries for the presence of EntryPointAttribute and issue a warning if it's found let CheckEntryPoint (tcGlobals: TcGlobals) (declaredImpls: CheckedImplFile list) = let tryGetEntryPoint (TBind(var = value)) = - TryFindFSharpAttribute tcGlobals tcGlobals.attrib_EntryPointAttribute value.Attribs - |> Option.map (fun attrib -> value.DisplayName, attrib) + if ValHasWellKnownAttribute tcGlobals WellKnownValAttributes.EntryPointAttribute value then + TryFindFSharpAttribute tcGlobals tcGlobals.attrib_EntryPointAttribute value.Attribs + |> Option.map (fun attrib -> value.DisplayName, attrib) + else + None let rec findEntryPointInContents = function diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index 0eba72d17ff..c982961e005 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -2746,9 +2746,9 @@ and TryOptimizeRecordFieldGet cenv _env (e1info, (RecdFieldRef (rtcref, _) as r) match destRecdValue e1info.Info with | Some finfos when cenv.settings.EliminateRecdFieldGet && not e1info.HasEffect -> - match TryFindFSharpAttribute g g.attrib_CLIMutableAttribute rtcref.Attribs with - | Some _ -> None - | None -> + if EntityHasWellKnownAttribute g WellKnownEntityAttributes.CLIMutableAttribute rtcref.Deref then + None + else let n = r.Index if n >= finfos.Length then errorR(InternalError( "TryOptimizeRecordFieldGet: term argument out of range", m)) Some finfos[n] From d5358f5c902eaee7fb06d7b0d4e29f2c780ce436 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 25 Feb 2026 14:59:04 +0100 Subject: [PATCH 17/71] Add missing enum cases to WellKnownEntityAttributes and WellKnownValAttributes Add ClassAttribute, InterfaceAttribute, StructAttribute, MeasureAttribute to WellKnownEntityAttributes enum (bits 0x8000000u-0x40000000u). Add NoCompilerInliningAttribute to WellKnownValAttributes enum (0x2000000uL). Update computeEntityWellKnownFlags and computeValWellKnownFlags to recognize the new attribute names in FSharp.Core paths. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TypedTree.fs | 27 ++++++++++++++++++-------- src/Compiler/TypedTree/TypedTree.fsi | 7 +++++++ src/Compiler/TypedTree/TypedTreeOps.fs | 25 ++++++++++++++++-------- 3 files changed, 43 insertions(+), 16 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 9f48ee9c8e5..9367095c3fd 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -2817,7 +2817,7 @@ type Val = val_member_info = None val_declaring_entity = ParentNone val_xmldocsig = String.Empty - val_attribs = WellKnownValAttribs.Create([]) } + val_attribs = WellKnownValAttribs.Empty } /// Range of the definition (implementation) of the value, used by Visual Studio member x.DefinitionRange = @@ -3058,7 +3058,7 @@ type Val = member x.ValAttribs = match x.val_opt_data with | Some optData -> optData.val_attribs - | _ -> WellKnownValAttribs.Create([]) + | _ -> WellKnownValAttribs.Empty /// Get the declared documentation for the value member x.XmlDoc = @@ -4675,6 +4675,10 @@ type WellKnownEntityAttributes = | AttributeUsageAttribute = 0x1000000u | WarnOnWithoutNullArgumentAttribute = 0x2000000u | AllowNullLiteralAttribute = 0x4000000u + | ClassAttribute = 0x8000000u + | InterfaceAttribute = 0x10000000u + | StructAttribute = 0x20000000u + | MeasureAttribute = 0x40000000u | NotComputed = 0x80000000u /// Wraps an Attrib list together with cached WellKnownEntityAttributes flags for O(1) lookup. @@ -4685,6 +4689,9 @@ type WellKnownEntityAttribs = new(attribs: Attrib list, flags: WellKnownEntityAttributes) = { attribs = attribs; flags = flags } + /// Shared singleton for entities with no attributes. + static member val Empty = WellKnownEntityAttribs([], WellKnownEntityAttributes.None) + /// Check if a specific well-known attribute flag is set. member x.HasWellKnownAttribute(flag: WellKnownEntityAttributes) : bool = x.flags &&& flag <> WellKnownEntityAttributes.None @@ -4698,7 +4705,7 @@ type WellKnownEntityAttribs = /// Create from an attribute list. If empty, flags = None. Otherwise NotComputed. static member Create(attribs: Attrib list) = if attribs.IsEmpty then - WellKnownEntityAttribs([], WellKnownEntityAttributes.None) + WellKnownEntityAttribs.Empty else WellKnownEntityAttribs(attribs, WellKnownEntityAttributes.NotComputed) @@ -4717,7 +4724,7 @@ type WellKnownEntityAttribs = /// Returns a copy with recomputed flags (flags set to NotComputed). member x.WithRecomputedFlags() = if x.attribs.IsEmpty then - WellKnownEntityAttribs([], WellKnownEntityAttributes.None) + WellKnownEntityAttribs.Empty else WellKnownEntityAttribs(x.attribs, WellKnownEntityAttributes.NotComputed) @@ -4751,6 +4758,7 @@ type WellKnownValAttributes = | InlineIfLambdaAttribute = 0x400000uL | OptionalAttribute = 0x800000uL | StructAttribute = 0x1000000uL + | NoCompilerInliningAttribute = 0x2000000uL | NotComputed = 0x8000000000000000uL /// Wraps an Attrib list together with cached WellKnownValAttributes flags for O(1) lookup. @@ -4761,6 +4769,9 @@ type WellKnownValAttribs = new(attribs: Attrib list, flags: WellKnownValAttributes) = { attribs = attribs; flags = flags } + /// Shared singleton for vals with no attributes. + static member val Empty = WellKnownValAttribs([], WellKnownValAttributes.None) + /// Check if a specific well-known attribute flag is set. member x.HasWellKnownAttribute(flag: WellKnownValAttributes) : bool = x.flags &&& flag <> WellKnownValAttributes.None @@ -4774,7 +4785,7 @@ type WellKnownValAttribs = /// Create from an attribute list. If empty, flags = None. Otherwise NotComputed. static member Create(attribs: Attrib list) = if attribs.IsEmpty then - WellKnownValAttribs([], WellKnownValAttributes.None) + WellKnownValAttribs.Empty else WellKnownValAttribs(attribs, WellKnownValAttributes.NotComputed) @@ -4793,7 +4804,7 @@ type WellKnownValAttribs = /// Returns a copy with recomputed flags (flags set to NotComputed). member x.WithRecomputedFlags() = if x.attribs.IsEmpty then - WellKnownValAttribs([], WellKnownValAttributes.None) + WellKnownValAttribs.Empty else WellKnownValAttribs(x.attribs, WellKnownValAttributes.NotComputed) @@ -6302,7 +6313,7 @@ type Construct() = entity_logical_name=name entity_range=m entity_flags=EntityFlags(usesPrefixDisplay=false, isModuleOrNamespace=false, preEstablishedHasDefaultCtor=false, hasSelfReferentialCtor=false, isStructRecordOrUnionType=false) - entity_attribs=WellKnownEntityAttribs.Create([]) // fetched on demand via est.fs API + entity_attribs=WellKnownEntityAttribs.Empty // fetched on demand via est.fs API entity_typars= LazyWithContext.NotLazy [] entity_tycon_repr = repr entity_tycon_tcaug=TyconAugmentation.Create() @@ -6445,7 +6456,7 @@ type Construct() = entity_logical_name=nm entity_range=m entity_flags=EntityFlags(usesPrefixDisplay=usesPrefixDisplay, isModuleOrNamespace=false, preEstablishedHasDefaultCtor=preEstablishedHasDefaultCtor, hasSelfReferentialCtor=hasSelfReferentialCtor, isStructRecordOrUnionType=false) - entity_attribs=WellKnownEntityAttribs.Create([]) // fixed up after + entity_attribs=WellKnownEntityAttribs.Empty // fixed up after entity_typars=typars entity_tycon_repr = TNoRepr entity_tycon_tcaug=TyconAugmentation.Create() diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index d2fdaeb88e6..8a401473749 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -3276,6 +3276,10 @@ type WellKnownEntityAttributes = | AttributeUsageAttribute = 0x1000000u | WarnOnWithoutNullArgumentAttribute = 0x2000000u | AllowNullLiteralAttribute = 0x4000000u + | ClassAttribute = 0x8000000u + | InterfaceAttribute = 0x10000000u + | StructAttribute = 0x20000000u + | MeasureAttribute = 0x40000000u | NotComputed = 0x80000000u /// Wraps an Attrib list together with cached WellKnownEntityAttributes flags for O(1) lookup. @@ -3284,6 +3288,7 @@ type WellKnownEntityAttribs = val private attribs: Attrib list val private flags: WellKnownEntityAttributes new: attribs: Attrib list * flags: WellKnownEntityAttributes -> WellKnownEntityAttribs + static member Empty: WellKnownEntityAttribs member HasWellKnownAttribute: flag: WellKnownEntityAttributes -> bool member AsList: unit -> Attrib list member Flags: WellKnownEntityAttributes @@ -3322,6 +3327,7 @@ type WellKnownValAttributes = | InlineIfLambdaAttribute = 0x400000uL | OptionalAttribute = 0x800000uL | StructAttribute = 0x1000000uL + | NoCompilerInliningAttribute = 0x2000000uL | NotComputed = 0x8000000000000000uL /// Wraps an Attrib list together with cached WellKnownValAttributes flags for O(1) lookup. @@ -3330,6 +3336,7 @@ type WellKnownValAttribs = val private attribs: Attrib list val private flags: WellKnownValAttributes new: attribs: Attrib list * flags: WellKnownValAttributes -> WellKnownValAttribs + static member Empty: WellKnownValAttribs member HasWellKnownAttribute: flag: WellKnownValAttributes -> bool member AsList: unit -> Attrib list member Flags: WellKnownValAttributes diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 00d434e8b08..d838585922f 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3790,6 +3790,10 @@ let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEnt flags <- flags ||| WellKnownEntityAttributes.AllowNullLiteralAttribute | "WarnOnWithoutNullArgumentAttribute" -> flags <- flags ||| WellKnownEntityAttributes.WarnOnWithoutNullArgumentAttribute + | "ClassAttribute" -> flags <- flags ||| WellKnownEntityAttributes.ClassAttribute + | "InterfaceAttribute" -> flags <- flags ||| WellKnownEntityAttributes.InterfaceAttribute + | "StructAttribute" -> flags <- flags ||| WellKnownEntityAttributes.StructAttribute + | "MeasureAttribute" -> flags <- flags ||| WellKnownEntityAttributes.MeasureAttribute | _ -> () | _ -> () | ValueNone -> () @@ -3839,8 +3843,9 @@ let EntityHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownEntityAttributes) let ea = entity.EntityAttribs if ea.Flags &&& WellKnownEntityAttributes.NotComputed <> WellKnownEntityAttributes.None then - let flags = computeEntityWellKnownFlags g (ea.AsList()) - entity.SetEntityAttribs(WellKnownEntityAttribs.CreateWithFlags(ea.AsList(), flags)) + let attribs = ea.AsList() + let flags = computeEntityWellKnownFlags g attribs + entity.SetEntityAttribs(WellKnownEntityAttribs.CreateWithFlags(attribs, flags)) flags &&& flag <> WellKnownEntityAttributes.None else ea.HasWellKnownAttribute(flag) @@ -3925,6 +3930,8 @@ let computeValWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownValAtt flags <- flags ||| WellKnownValAttributes.ProjectionParameterAttribute | "InlineIfLambdaAttribute" -> flags <- flags ||| WellKnownValAttributes.InlineIfLambdaAttribute | "StructAttribute" -> flags <- flags ||| WellKnownValAttributes.StructAttribute + | "NoCompilerInliningAttribute" -> + flags <- flags ||| WellKnownValAttributes.NoCompilerInliningAttribute | _ -> () | _ -> () | ValueNone -> () @@ -3936,8 +3943,9 @@ let ArgReprInfoHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownValAttribute let wa = argInfo.Attribs if wa.Flags &&& WellKnownValAttributes.NotComputed <> WellKnownValAttributes.None then - let flags = computeValWellKnownFlags g (wa.AsList()) - argInfo.Attribs <- WellKnownValAttribs.CreateWithFlags(wa.AsList(), flags) + let attribs = wa.AsList() + let flags = computeValWellKnownFlags g attribs + argInfo.Attribs <- WellKnownValAttribs.CreateWithFlags(attribs, flags) flags &&& flag <> WellKnownValAttributes.None else wa.HasWellKnownAttribute(flag) @@ -3947,8 +3955,9 @@ let ValHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownValAttributes) (v: V let va = v.ValAttribs if va.Flags &&& WellKnownValAttributes.NotComputed <> WellKnownValAttributes.None then - let flags = computeValWellKnownFlags g (va.AsList()) - v.SetValAttribs(WellKnownValAttribs.CreateWithFlags(va.AsList(), flags)) + let attribs = va.AsList() + let flags = computeValWellKnownFlags g attribs + v.SetValAttribs(WellKnownValAttribs.CreateWithFlags(attribs, flags)) flags &&& flag <> WellKnownValAttributes.None else va.HasWellKnownAttribute(flag) @@ -4039,7 +4048,7 @@ let TyconRefHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownILAttributes) ( false let HasDefaultAugmentationAttribute g (tcref: TyconRef) = - match TryFindFSharpAttribute g g.attrib_DefaultAugmentationAttribute tcref.Attribs with + match TryFindFSharpAttribute g g.attrib_DefaultAugmentationAttribute tcref.Attribs with // TODO: WELLKNOWN_ATTRIB - bool extraction | Some(Attrib(_, _, [ AttribBoolArg b ], _, _, _, _)) -> b | Some (Attrib(_, _, _, _, _, _, m)) -> errorR(Error(FSComp.SR.ilDefaultAugmentationAttributeCouldNotBeDecoded(), m)) @@ -9934,7 +9943,7 @@ let isSealedTy g ty = | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> if (isFSharpInterfaceTy g ty || isFSharpClassTy g ty) then let tcref = tcrefOfAppTy g ty - TryFindFSharpBoolAttribute g g.attrib_SealedAttribute tcref.Attribs = Some true + TryFindFSharpBoolAttribute g g.attrib_SealedAttribute tcref.Attribs = Some true // TODO: WELLKNOWN_ATTRIB else // All other F# types, array, byref, tuple types are sealed true From dc157456cea51ccf0405a9caebf50ce398f740d7 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 25 Feb 2026 15:36:30 +0100 Subject: [PATCH 18/71] Bool TrueFalse encoding for three-state attributes Add _True/_False flag pairs for attributes that carry boolean semantics: Entity enum: DefaultAugmentationAttribute_True/_False, AutoSerializableAttribute_True/_False (widened enum to uint64) Val enum: ReflectedDefinitionAttribute_True/_False, DefaultValueAttribute_True/_False, NoDynamicInvocationAttribute_True/_False Compute functions now extract bool args from attribute constructors and set the appropriate flag. Added EntityTryGetBoolAttribute and ValTryGetBoolAttribute helpers. Migrated all TODO WELLKNOWN_ATTRIB bool extraction call sites: - TypedTreeOps.fs: HasDefaultAugmentationAttribute, isSealedTy - IlxGen.fs: DefaultAugmentation, NoDynamicInvocation, AutoSerializable - PostInferenceChecks.fs: DefaultAugmentation - infos.fs: ReflectedDefinition on ArgReprInfo Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../Checking/Expressions/CheckExpressions.fs | 6 +- src/Compiler/Checking/PostInferenceChecks.fs | 8 +- src/Compiler/Checking/infos.fs | 13 +++- src/Compiler/CodeGen/IlxGen.fs | 33 ++++---- src/Compiler/TypedTree/TypedTree.fs | 77 ++++++++++--------- src/Compiler/TypedTree/TypedTree.fsi | 77 ++++++++++--------- src/Compiler/TypedTree/TypedTreeOps.fs | 75 +++++++++++++++--- src/Compiler/TypedTree/TypedTreeOps.fsi | 12 +++ 8 files changed, 194 insertions(+), 107 deletions(-) diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 88aae6c907d..00e7eba9718 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -2164,7 +2164,7 @@ module GeneralizationHelpers = // Applications of type functions are _not_ normally generalizable unless explicitly marked so | Expr.App (Expr.Val (vref, _, _), _, _, [], _) when vref.IsTypeFunction -> - HasFSharpAttribute g g.attrib_GeneralizableValueAttribute vref.Attribs + HasFSharpAttribute g g.attrib_GeneralizableValueAttribute vref.Attribs // TODO: WELLKNOWN_ATTRIB | Expr.App (expr1, _, _, [], _) -> IsGeneralizableValue g expr1 | Expr.TyChoose (_, b, _) -> IsGeneralizableValue g b @@ -11147,7 +11147,7 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt | _ -> false | _ -> false - if valAttribFlags &&& WellKnownValAttributes.DefaultValueAttribute <> WellKnownValAttributes.None && not isZeroMethod then + if valAttribFlags &&& (WellKnownValAttributes.DefaultValueAttribute_True ||| WellKnownValAttributes.DefaultValueAttribute_False) <> WellKnownValAttributes.None && not isZeroMethod then errorR(Error(FSComp.SR.tcDefaultValueAttributeRequiresVal(), mBinding)) let isThreadStatic = isThreadOrContextStatic g valAttribs @@ -11447,7 +11447,7 @@ and CheckAttributeUsage (g: TcGlobals) (mAttr: range) (tcref: TyconRef) (attrTgt | _ -> (validOnDefault, inheritedDefault) else - match (TryFindFSharpAttribute g g.attrib_AttributeUsageAttribute tcref.Attribs) with + match (TryFindFSharpAttribute g g.attrib_AttributeUsageAttribute tcref.Attribs) with // TODO: WELLKNOWN_ATTRIB - value extraction | Some(Attrib(unnamedArgs = [ AttribInt32Arg validOn ])) -> validOn, inheritedDefault | Some(Attrib(unnamedArgs = [ AttribInt32Arg validOn; AttribBoolArg(_allowMultiple); AttribBoolArg inherited])) -> diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 719eec67ae5..5678277fd22 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -2119,7 +2119,7 @@ and CheckBinding cenv env alwaysCheckNoReraise ctxt (TBind(v, bindRhs, _) as bin (// Check the attributes on any enclosing module env.reflect || // Check the attributes on the value - ValHasWellKnownAttribute g WellKnownValAttributes.ReflectedDefinitionAttribute v || + ValHasWellKnownAttribute g WellKnownValAttributes.ReflectedDefinitionAttribute_True v || // Also check the enclosing type for members - for historical reasons, in the TAST member values // are stored in the entity that encloses the type, hence we will not have noticed the ReflectedDefinition // on the enclosing type at this point. @@ -2226,9 +2226,9 @@ let CheckModuleBinding cenv env (TBind(v, e, _) as bind) = let tcref = v.DeclaringEntity let hasDefaultAugmentation = tcref.IsUnionTycon && - match TryFindFSharpAttribute g g.attrib_DefaultAugmentationAttribute tcref.Attribs with - | Some(Attrib(_, _, [ AttribBoolArg b ], _, _, _, _)) -> b - | _ -> true (* not hiddenRepr *) + match EntityTryGetBoolAttribute g WellKnownEntityAttributes.DefaultAugmentationAttribute_True WellKnownEntityAttributes.DefaultAugmentationAttribute_False tcref.Deref with + | Some b -> b + | None -> true let kind = (if v.IsMember then "member" else "value") let check skipValCheck nm = diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index 500eba0f6b2..9b31abde0d0 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -277,9 +277,16 @@ let CrackParamAttribsInfo g (ty: TType, argInfo: ArgReprInfo) = let attribs = argInfo.Attribs.AsList() let isParamArrayArg = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.ParamArrayAttribute argInfo let reflArgInfo = - match TryFindFSharpBoolAttributeAssumeFalse g g.attrib_ReflectedDefinitionAttribute attribs with - | Some b -> ReflectedArgInfo.Quote b - | None -> ReflectedArgInfo.None + let _ = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.ReflectedDefinitionAttribute_True argInfo + + let wa = argInfo.Attribs + + if wa.HasWellKnownAttribute(WellKnownValAttributes.ReflectedDefinitionAttribute_True) then + ReflectedArgInfo.Quote true + elif wa.HasWellKnownAttribute(WellKnownValAttributes.ReflectedDefinitionAttribute_False) then + ReflectedArgInfo.Quote false + else + ReflectedArgInfo.None let isOutArg = (ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.OutAttribute argInfo && isByrefTy g ty) || isOutByrefTy g ty let isInArg = (ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.InAttribute argInfo && isByrefTy g ty) || isInByrefTy g ty let isCalleeSideOptArg = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.OptionalArgumentAttribute argInfo diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 30acae4ff6a..73ca26d1961 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -791,12 +791,16 @@ and ComputeUnionHasHelpers g (tcref: TyconRef) = elif tyconRefEq g tcref g.option_tcr_canon then SpecialFSharpOptionHelpers else - match TryFindFSharpAttribute g g.attrib_DefaultAugmentationAttribute tcref.Attribs with // TODO: WELLKNOWN_ATTRIB - bool extraction - | Some(Attrib(_, _, [ AttribBoolArg b ], _, _, _, _)) -> if b then AllHelpers else NoHelpers - | Some(Attrib(_, _, _, _, _, _, m)) -> - errorR (Error(FSComp.SR.ilDefaultAugmentationAttributeCouldNotBeDecoded (), m)) - AllHelpers - | _ -> AllHelpers (* not hiddenRepr *) + match + EntityTryGetBoolAttribute + g + WellKnownEntityAttributes.DefaultAugmentationAttribute_True + WellKnownEntityAttributes.DefaultAugmentationAttribute_False + tcref.Deref + with + | Some true -> AllHelpers + | Some false -> NoHelpers + | None -> AllHelpers and GenUnionSpec (cenv: cenv) m tyenv tcref tyargs = let curef = GenUnionRef cenv m tcref @@ -9303,12 +9307,15 @@ and GenMethodForBinding // For witness-passing methods, don't do this if `isLegacy` flag specified // on the attribute. Older compilers let bodyExpr = - let attr = - TryFindFSharpBoolAttributeAssumeFalse cenv.g cenv.g.attrib_NoDynamicInvocationAttribute v.Attribs // TODO: WELLKNOWN_ATTRIB + let hasNoDynInvocTrue = + ValHasWellKnownAttribute cenv.g WellKnownValAttributes.NoDynamicInvocationAttribute_True v + + let hasNoDynInvocFalse = + ValHasWellKnownAttribute cenv.g WellKnownValAttributes.NoDynamicInvocationAttribute_False v if - (not generateWitnessArgs && attr.IsSome) - || (generateWitnessArgs && attr = Some false) + (not generateWitnessArgs && (hasNoDynInvocTrue || hasNoDynInvocFalse)) + || (generateWitnessArgs && hasNoDynInvocFalse) then let exnArg = mkString cenv.g m (FSComp.SR.ilDynamicInvocationNotSupported (v.CompiledName g.CompilerGlobalState)) @@ -9612,7 +9619,8 @@ and GenMethodForBinding mdef // Does the function have an explicit [] attribute? - let isExplicitEntryPoint = ValHasWellKnownAttribute g WellKnownValAttributes.EntryPointAttribute v + let isExplicitEntryPoint = + ValHasWellKnownAttribute g WellKnownValAttributes.EntryPointAttribute v let mdef = mdef @@ -11483,8 +11491,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option let tdef, tdefDiscards = let isSerializable = - (TryFindFSharpBoolAttribute g g.attrib_AutoSerializableAttribute tycon.Attribs // TODO: WELLKNOWN_ATTRIB - <> Some false) + (not (EntityHasWellKnownAttribute g WellKnownEntityAttributes.AutoSerializableAttribute_False tycon)) match tycon.TypeReprInfo with | TILObjectRepr _ -> diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 9367095c3fd..934b95c23c0 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -4647,39 +4647,41 @@ type Measure = /// Used to avoid O(N) linear scans of attribute lists. [] type WellKnownEntityAttributes = - | None = 0u - | RequireQualifiedAccessAttribute = 0x1u - | AutoOpenAttribute = 0x2u - | AbstractClassAttribute = 0x4u - | SealedAttribute = 0x8u - | NoEqualityAttribute = 0x10u - | NoComparisonAttribute = 0x20u - | StructuralEqualityAttribute = 0x40u - | StructuralComparisonAttribute = 0x80u - | CustomEqualityAttribute = 0x100u - | CustomComparisonAttribute = 0x200u - | ReferenceEqualityAttribute = 0x400u - | DefaultAugmentationAttribute = 0x800u - | CLIMutableAttribute = 0x1000u - | AutoSerializableAttribute = 0x2000u - | StructLayoutAttribute = 0x4000u - | DllImportAttribute = 0x8000u - | ReflectedDefinitionAttribute = 0x10000u - | GeneralizableValueAttribute = 0x20000u - | SkipLocalsInitAttribute = 0x40000u - | DebuggerTypeProxyAttribute = 0x80000u - | ComVisibleAttribute = 0x100000u - | IsReadOnlyAttribute = 0x200000u - | IsByRefLikeAttribute = 0x400000u - | ExtensionAttribute = 0x800000u - | AttributeUsageAttribute = 0x1000000u - | WarnOnWithoutNullArgumentAttribute = 0x2000000u - | AllowNullLiteralAttribute = 0x4000000u - | ClassAttribute = 0x8000000u - | InterfaceAttribute = 0x10000000u - | StructAttribute = 0x20000000u - | MeasureAttribute = 0x40000000u - | NotComputed = 0x80000000u + | None = 0uL + | RequireQualifiedAccessAttribute = 0x1uL + | AutoOpenAttribute = 0x2uL + | AbstractClassAttribute = 0x4uL + | SealedAttribute = 0x8uL + | NoEqualityAttribute = 0x10uL + | NoComparisonAttribute = 0x20uL + | StructuralEqualityAttribute = 0x40uL + | StructuralComparisonAttribute = 0x80uL + | CustomEqualityAttribute = 0x100uL + | CustomComparisonAttribute = 0x200uL + | ReferenceEqualityAttribute = 0x400uL + | DefaultAugmentationAttribute_True = 0x800uL + | CLIMutableAttribute = 0x1000uL + | AutoSerializableAttribute_True = 0x2000uL + | StructLayoutAttribute = 0x4000uL + | DllImportAttribute = 0x8000uL + | ReflectedDefinitionAttribute = 0x10000uL + | GeneralizableValueAttribute = 0x20000uL + | SkipLocalsInitAttribute = 0x40000uL + | DebuggerTypeProxyAttribute = 0x80000uL + | ComVisibleAttribute = 0x100000uL + | IsReadOnlyAttribute = 0x200000uL + | IsByRefLikeAttribute = 0x400000uL + | ExtensionAttribute = 0x800000uL + | AttributeUsageAttribute = 0x1000000uL + | WarnOnWithoutNullArgumentAttribute = 0x2000000uL + | AllowNullLiteralAttribute = 0x4000000uL + | ClassAttribute = 0x8000000uL + | InterfaceAttribute = 0x10000000uL + | StructAttribute = 0x20000000uL + | MeasureAttribute = 0x40000000uL + | DefaultAugmentationAttribute_False = 0x80000000uL + | AutoSerializableAttribute_False = 0x100000000uL + | NotComputed = 0x8000000000000000uL /// Wraps an Attrib list together with cached WellKnownEntityAttributes flags for O(1) lookup. [] @@ -4737,14 +4739,14 @@ type WellKnownValAttributes = | EntryPointAttribute = 0x2uL | LiteralAttribute = 0x4uL | ConditionalAttribute = 0x8uL - | ReflectedDefinitionAttribute = 0x10uL + | ReflectedDefinitionAttribute_True = 0x10uL | RequiresExplicitTypeArgumentsAttribute = 0x20uL - | DefaultValueAttribute = 0x40uL + | DefaultValueAttribute_True = 0x40uL | SkipLocalsInitAttribute = 0x80uL | ThreadStaticAttribute = 0x100uL | ContextStaticAttribute = 0x200uL | VolatileFieldAttribute = 0x400uL - | NoDynamicInvocationAttribute = 0x800uL + | NoDynamicInvocationAttribute_True = 0x800uL | ExtensionAttribute = 0x1000uL | OptionalArgumentAttribute = 0x2000uL | InAttribute = 0x4000uL @@ -4759,6 +4761,9 @@ type WellKnownValAttributes = | OptionalAttribute = 0x800000uL | StructAttribute = 0x1000000uL | NoCompilerInliningAttribute = 0x2000000uL + | ReflectedDefinitionAttribute_False = 0x4000000uL + | DefaultValueAttribute_False = 0x8000000uL + | NoDynamicInvocationAttribute_False = 0x10000000uL | NotComputed = 0x8000000000000000uL /// Wraps an Attrib list together with cached WellKnownValAttributes flags for O(1) lookup. diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index 8a401473749..c93c2f5d59e 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -3248,39 +3248,41 @@ type Measure = /// Flags enum for well-known attributes on Entity (types and modules). [] type WellKnownEntityAttributes = - | None = 0u - | RequireQualifiedAccessAttribute = 0x1u - | AutoOpenAttribute = 0x2u - | AbstractClassAttribute = 0x4u - | SealedAttribute = 0x8u - | NoEqualityAttribute = 0x10u - | NoComparisonAttribute = 0x20u - | StructuralEqualityAttribute = 0x40u - | StructuralComparisonAttribute = 0x80u - | CustomEqualityAttribute = 0x100u - | CustomComparisonAttribute = 0x200u - | ReferenceEqualityAttribute = 0x400u - | DefaultAugmentationAttribute = 0x800u - | CLIMutableAttribute = 0x1000u - | AutoSerializableAttribute = 0x2000u - | StructLayoutAttribute = 0x4000u - | DllImportAttribute = 0x8000u - | ReflectedDefinitionAttribute = 0x10000u - | GeneralizableValueAttribute = 0x20000u - | SkipLocalsInitAttribute = 0x40000u - | DebuggerTypeProxyAttribute = 0x80000u - | ComVisibleAttribute = 0x100000u - | IsReadOnlyAttribute = 0x200000u - | IsByRefLikeAttribute = 0x400000u - | ExtensionAttribute = 0x800000u - | AttributeUsageAttribute = 0x1000000u - | WarnOnWithoutNullArgumentAttribute = 0x2000000u - | AllowNullLiteralAttribute = 0x4000000u - | ClassAttribute = 0x8000000u - | InterfaceAttribute = 0x10000000u - | StructAttribute = 0x20000000u - | MeasureAttribute = 0x40000000u - | NotComputed = 0x80000000u + | None = 0uL + | RequireQualifiedAccessAttribute = 0x1uL + | AutoOpenAttribute = 0x2uL + | AbstractClassAttribute = 0x4uL + | SealedAttribute = 0x8uL + | NoEqualityAttribute = 0x10uL + | NoComparisonAttribute = 0x20uL + | StructuralEqualityAttribute = 0x40uL + | StructuralComparisonAttribute = 0x80uL + | CustomEqualityAttribute = 0x100uL + | CustomComparisonAttribute = 0x200uL + | ReferenceEqualityAttribute = 0x400uL + | DefaultAugmentationAttribute_True = 0x800uL + | CLIMutableAttribute = 0x1000uL + | AutoSerializableAttribute_True = 0x2000uL + | StructLayoutAttribute = 0x4000uL + | DllImportAttribute = 0x8000uL + | ReflectedDefinitionAttribute = 0x10000uL + | GeneralizableValueAttribute = 0x20000uL + | SkipLocalsInitAttribute = 0x40000uL + | DebuggerTypeProxyAttribute = 0x80000uL + | ComVisibleAttribute = 0x100000uL + | IsReadOnlyAttribute = 0x200000uL + | IsByRefLikeAttribute = 0x400000uL + | ExtensionAttribute = 0x800000uL + | AttributeUsageAttribute = 0x1000000uL + | WarnOnWithoutNullArgumentAttribute = 0x2000000uL + | AllowNullLiteralAttribute = 0x4000000uL + | ClassAttribute = 0x8000000uL + | InterfaceAttribute = 0x10000000uL + | StructAttribute = 0x20000000uL + | MeasureAttribute = 0x40000000uL + | DefaultAugmentationAttribute_False = 0x80000000uL + | AutoSerializableAttribute_False = 0x100000000uL + | NotComputed = 0x8000000000000000uL /// Wraps an Attrib list together with cached WellKnownEntityAttributes flags for O(1) lookup. [] @@ -3306,14 +3308,14 @@ type WellKnownValAttributes = | EntryPointAttribute = 0x2uL | LiteralAttribute = 0x4uL | ConditionalAttribute = 0x8uL - | ReflectedDefinitionAttribute = 0x10uL + | ReflectedDefinitionAttribute_True = 0x10uL | RequiresExplicitTypeArgumentsAttribute = 0x20uL - | DefaultValueAttribute = 0x40uL + | DefaultValueAttribute_True = 0x40uL | SkipLocalsInitAttribute = 0x80uL | ThreadStaticAttribute = 0x100uL | ContextStaticAttribute = 0x200uL | VolatileFieldAttribute = 0x400uL - | NoDynamicInvocationAttribute = 0x800uL + | NoDynamicInvocationAttribute_True = 0x800uL | ExtensionAttribute = 0x1000uL | OptionalArgumentAttribute = 0x2000uL | InAttribute = 0x4000uL @@ -3328,6 +3330,9 @@ type WellKnownValAttributes = | OptionalAttribute = 0x800000uL | StructAttribute = 0x1000000uL | NoCompilerInliningAttribute = 0x2000000uL + | ReflectedDefinitionAttribute_False = 0x4000000uL + | DefaultValueAttribute_False = 0x8000000uL + | NoDynamicInvocationAttribute_False = 0x10000000uL | NotComputed = 0x8000000000000000uL /// Wraps an Attrib list together with cached WellKnownValAttributes flags for O(1) lookup. diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index d838585922f..7e90617f825 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3778,10 +3778,24 @@ let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEnt | "ReferenceEqualityAttribute" -> flags <- flags ||| WellKnownEntityAttributes.ReferenceEqualityAttribute | "DefaultAugmentationAttribute" -> - flags <- flags ||| WellKnownEntityAttributes.DefaultAugmentationAttribute + match attrib with + | Attrib(_, _, [ AttribBoolArg b ], _, _, _, _) -> + if b then + flags <- flags ||| WellKnownEntityAttributes.DefaultAugmentationAttribute_True + else + flags <- flags ||| WellKnownEntityAttributes.DefaultAugmentationAttribute_False + | _ -> + flags <- flags ||| WellKnownEntityAttributes.DefaultAugmentationAttribute_True | "CLIMutableAttribute" -> flags <- flags ||| WellKnownEntityAttributes.CLIMutableAttribute | "AutoSerializableAttribute" -> - flags <- flags ||| WellKnownEntityAttributes.AutoSerializableAttribute + match attrib with + | Attrib(_, _, [ AttribBoolArg b ], _, _, _, _) -> + if b then + flags <- flags ||| WellKnownEntityAttributes.AutoSerializableAttribute_True + else + flags <- flags ||| WellKnownEntityAttributes.AutoSerializableAttribute_False + | _ -> + flags <- flags ||| WellKnownEntityAttributes.AutoSerializableAttribute_True | "ReflectedDefinitionAttribute" -> flags <- flags ||| WellKnownEntityAttributes.ReflectedDefinitionAttribute | "GeneralizableValueAttribute" -> @@ -3917,13 +3931,35 @@ let computeValWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownValAtt | "EntryPointAttribute" -> flags <- flags ||| WellKnownValAttributes.EntryPointAttribute | "LiteralAttribute" -> flags <- flags ||| WellKnownValAttributes.LiteralAttribute | "ReflectedDefinitionAttribute" -> - flags <- flags ||| WellKnownValAttributes.ReflectedDefinitionAttribute + match attrib with + | Attrib(_, _, [ AttribBoolArg b ], _, _, _, _) -> + if b then + flags <- flags ||| WellKnownValAttributes.ReflectedDefinitionAttribute_True + else + flags <- flags ||| WellKnownValAttributes.ReflectedDefinitionAttribute_False + | _ -> + flags <- flags ||| WellKnownValAttributes.ReflectedDefinitionAttribute_True | "RequiresExplicitTypeArgumentsAttribute" -> flags <- flags ||| WellKnownValAttributes.RequiresExplicitTypeArgumentsAttribute - | "DefaultValueAttribute" -> flags <- flags ||| WellKnownValAttributes.DefaultValueAttribute + | "DefaultValueAttribute" -> + match attrib with + | Attrib(_, _, [ AttribBoolArg b ], _, _, _, _) -> + if b then + flags <- flags ||| WellKnownValAttributes.DefaultValueAttribute_True + else + flags <- flags ||| WellKnownValAttributes.DefaultValueAttribute_False + | _ -> + flags <- flags ||| WellKnownValAttributes.DefaultValueAttribute_True | "VolatileFieldAttribute" -> flags <- flags ||| WellKnownValAttributes.VolatileFieldAttribute | "NoDynamicInvocationAttribute" -> - flags <- flags ||| WellKnownValAttributes.NoDynamicInvocationAttribute + match attrib with + | Attrib(_, _, [ AttribBoolArg b ], _, _, _, _) -> + if b then + flags <- flags ||| WellKnownValAttributes.NoDynamicInvocationAttribute_True + else + flags <- flags ||| WellKnownValAttributes.NoDynamicInvocationAttribute_False + | _ -> + flags <- flags ||| WellKnownValAttributes.NoDynamicInvocationAttribute_True | "OptionalArgumentAttribute" -> flags <- flags ||| WellKnownValAttributes.OptionalArgumentAttribute | "ProjectionParameterAttribute" -> @@ -3962,6 +3998,24 @@ let ValHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownValAttributes) (v: V else va.HasWellKnownAttribute(flag) +/// Query a three-state bool attribute on an entity. Returns bool option. +let EntityTryGetBoolAttribute (g: TcGlobals) (trueFlag: WellKnownEntityAttributes) (falseFlag: WellKnownEntityAttributes) (entity: Entity) : bool option = + let _ = EntityHasWellKnownAttribute g trueFlag entity + let ea = entity.EntityAttribs + + if ea.HasWellKnownAttribute(trueFlag) then Some true + elif ea.HasWellKnownAttribute(falseFlag) then Some false + else Option.None + +/// Query a three-state bool attribute on a Val. Returns bool option. +let ValTryGetBoolAttribute (g: TcGlobals) (trueFlag: WellKnownValAttributes) (falseFlag: WellKnownValAttributes) (v: Val) : bool option = + let _ = ValHasWellKnownAttribute g trueFlag v + let va = v.ValAttribs + + if va.HasWellKnownAttribute(trueFlag) then Some true + elif va.HasWellKnownAttribute(falseFlag) then Some false + else Option.None + /// Analyze three cases for attributes declared on type definitions: IL-declared attributes, F#-declared attributes and /// provided attributes. // @@ -4048,12 +4102,9 @@ let TyconRefHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownILAttributes) ( false let HasDefaultAugmentationAttribute g (tcref: TyconRef) = - match TryFindFSharpAttribute g g.attrib_DefaultAugmentationAttribute tcref.Attribs with // TODO: WELLKNOWN_ATTRIB - bool extraction - | Some(Attrib(_, _, [ AttribBoolArg b ], _, _, _, _)) -> b - | Some (Attrib(_, _, _, _, _, _, m)) -> - errorR(Error(FSComp.SR.ilDefaultAugmentationAttributeCouldNotBeDecoded(), m)) - true - | _ -> true + match EntityTryGetBoolAttribute g WellKnownEntityAttributes.DefaultAugmentationAttribute_True WellKnownEntityAttributes.DefaultAugmentationAttribute_False tcref.Deref with + | Some b -> b + | None -> true /// Check if a type definition has an attribute with a specific full name let TyconRefHasAttributeByName (m: range) attrFullName (tcref: TyconRef) = @@ -9943,7 +9994,7 @@ let isSealedTy g ty = | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> if (isFSharpInterfaceTy g ty || isFSharpClassTy g ty) then let tcref = tcrefOfAppTy g ty - TryFindFSharpBoolAttribute g g.attrib_SealedAttribute tcref.Attribs = Some true // TODO: WELLKNOWN_ATTRIB + EntityHasWellKnownAttribute g WellKnownEntityAttributes.SealedAttribute tcref.Deref else // All other F# types, array, byref, tuple types are sealed true diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index be0489f16b5..cc24c06554c 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2413,6 +2413,18 @@ val ArgReprInfoHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownValAttribut /// Check if a Val has a specific well-known attribute, computing and caching flags if needed. val ValHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownValAttributes -> v: Val -> bool +/// Query a three-state bool attribute on an entity. Returns bool option. +val EntityTryGetBoolAttribute: + g: TcGlobals -> + trueFlag: WellKnownEntityAttributes -> + falseFlag: WellKnownEntityAttributes -> + entity: Entity -> + bool option + +/// Query a three-state bool attribute on a Val. Returns bool option. +val ValTryGetBoolAttribute: + g: TcGlobals -> trueFlag: WellKnownValAttributes -> falseFlag: WellKnownValAttributes -> v: Val -> bool option + val IsMatchingFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attrib -> bool val IsMatchingFSharpAttributeOpt: TcGlobals -> BuiltinAttribInfo option -> Attrib -> bool From e97f7fe76a251d4fbc56f657be445be7e3760fc5 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 25 Feb 2026 16:19:59 +0100 Subject: [PATCH 19/71] Fix NoDynamicInvocation/ReflectedDefinition default to false (AssumeFalse semantics) The original code used TryFindFSharpBoolAttributeAssumeFalse for these two attributes, which defaults to false when no explicit bool argument is present. The | _ -> fallback incorrectly set _True; corrected to _False. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TypedTreeOps.fs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 7e90617f825..a18912ba084 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3938,7 +3938,8 @@ let computeValWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownValAtt else flags <- flags ||| WellKnownValAttributes.ReflectedDefinitionAttribute_False | _ -> - flags <- flags ||| WellKnownValAttributes.ReflectedDefinitionAttribute_True + // TryFindFSharpBoolAttributeAssumeFalse semantics: no explicit arg defaults to false + flags <- flags ||| WellKnownValAttributes.ReflectedDefinitionAttribute_False | "RequiresExplicitTypeArgumentsAttribute" -> flags <- flags ||| WellKnownValAttributes.RequiresExplicitTypeArgumentsAttribute | "DefaultValueAttribute" -> @@ -3959,7 +3960,8 @@ let computeValWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownValAtt else flags <- flags ||| WellKnownValAttributes.NoDynamicInvocationAttribute_False | _ -> - flags <- flags ||| WellKnownValAttributes.NoDynamicInvocationAttribute_True + // TryFindFSharpBoolAttributeAssumeFalse semantics: no explicit arg defaults to false + flags <- flags ||| WellKnownValAttributes.NoDynamicInvocationAttribute_False | "OptionalArgumentAttribute" -> flags <- flags ||| WellKnownValAttributes.OptionalArgumentAttribute | "ProjectionParameterAttribute" -> From a978929d3df4d6319c4088697034011eb36acc5c Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 25 Feb 2026 17:02:21 +0100 Subject: [PATCH 20/71] Fix ReflectedDefinitionAttribute existence check to include _False flag The existence check at PostInferenceChecks.fs line 2122 must check both _True and _False flags since [] without explicit bool arg sets _False (matching TryFindFSharpBoolAttributeAssumeFalse semantics). Without this fix, bare [] on struct members would not trigger the FS1220 error. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/PostInferenceChecks.fs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 5678277fd22..c2d6eea4652 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -2120,6 +2120,7 @@ and CheckBinding cenv env alwaysCheckNoReraise ctxt (TBind(v, bindRhs, _) as bin env.reflect || // Check the attributes on the value ValHasWellKnownAttribute g WellKnownValAttributes.ReflectedDefinitionAttribute_True v || + ValHasWellKnownAttribute g WellKnownValAttributes.ReflectedDefinitionAttribute_False v || // Also check the enclosing type for members - for historical reasons, in the TAST member values // are stored in the entity that encloses the type, hence we will not have noticed the ReflectedDefinition // on the enclosing type at this point. From 7fa711d316d2e517dbaea76893b8c5dedc977314 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 25 Feb 2026 17:51:42 +0100 Subject: [PATCH 21/71] Flatten ILAttributesStored: eliminate Computed DU case Replace the Computed(ILAttributes * WellKnownILAttributes) DU case with a separate mutable wellKnownFlags field on ILAttributesStored. This avoids allocating a new DU case on every GetOrComputeWellKnownFlags call, reducing GC pressure for IL type definitions, methods, and fields. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/AbstractIL/il.fs | 17 +++++++++-------- 1 file changed, 9 insertions(+), 8 deletions(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index ad3da5cbc6e..5fe759c18de 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -1256,17 +1256,16 @@ type WellKnownILAttributes = type internal ILAttributesStoredRepr = | Reader of (int32 -> ILAttribute[]) | Given of ILAttributes - | Computed of ILAttributes * WellKnownILAttributes [] type ILAttributesStored private (metadataIndex: int32, initial: ILAttributesStoredRepr) = let mutable repr = initial + let mutable wellKnownFlags = WellKnownILAttributes.NotComputed member _.MetadataIndex = metadataIndex member x.CustomAttrs: ILAttributes = match repr with - | Computed(a, _) | Given a -> a | Reader f -> let r = ILAttributes(f metadataIndex) @@ -1280,13 +1279,15 @@ type ILAttributesStored private (metadataIndex: int32, initial: ILAttributesStor x.GetOrComputeWellKnownFlags(compute) &&& flag <> WellKnownILAttributes.None member x.GetOrComputeWellKnownFlags(compute: ILAttributes -> WellKnownILAttributes) : WellKnownILAttributes = - match repr with - | Computed(_, flags) -> flags - | _ -> - let a = x.CustomAttrs - let f = compute a - repr <- Computed(a, f) + let f = wellKnownFlags + + if f <> WellKnownILAttributes.NotComputed then f + else + let a = x.CustomAttrs + let computed = compute a + wellKnownFlags <- computed + computed static member CreateReader(idx: int32, f: int32 -> ILAttribute[]) = ILAttributesStored(idx, Reader f) From cc91bb1ed914a7be973ef4223c44218c9dbde0a1 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 25 Feb 2026 18:33:48 +0100 Subject: [PATCH 22/71] Fast negative guards and perf improvements for attribute checks - Add fast negative guard for StructLayoutAttribute in IlxGen.fs - Add fast negative guard for AttributeUsageAttribute in CheckExpressions.fs - Optimize CombineCcuContentFragments to avoid list concat when one side is empty - Use WellKnownEntityAttribs.Add for extension attribute additions - Remove TODO: WELLKNOWN_ATTRIB comments from guarded sites Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/CheckDeclarations.fs | 2 +- .../Checking/Expressions/CheckExpressions.fs | 21 ++-- src/Compiler/CodeGen/IlxGen.fs | 104 +++++++++--------- src/Compiler/TypedTree/TypedTreeOps.fs | 9 +- 4 files changed, 71 insertions(+), 65 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 9456351b9be..e7a1b0bb64d 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -4806,7 +4806,7 @@ module TcDeclarations = match extensionAttributeOnVals, typeEntity with | Some extensionAttribute, Some typeEntity -> if Option.isNone (tryFindExtensionAttribute g typeEntity.Attribs) then - typeEntity.entity_attribs <- WellKnownEntityAttribs.Create(extensionAttribute :: typeEntity.Attribs) + typeEntity.entity_attribs <- typeEntity.EntityAttribs.Add(extensionAttribute, WellKnownEntityAttributes.ExtensionAttribute) | _ -> () vals, env diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 00e7eba9718..fe99e5e9c2f 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -11447,15 +11447,18 @@ and CheckAttributeUsage (g: TcGlobals) (mAttr: range) (tcref: TyconRef) (attrTgt | _ -> (validOnDefault, inheritedDefault) else - match (TryFindFSharpAttribute g g.attrib_AttributeUsageAttribute tcref.Attribs) with // TODO: WELLKNOWN_ATTRIB - value extraction - | Some(Attrib(unnamedArgs = [ AttribInt32Arg validOn ])) -> - validOn, inheritedDefault - | Some(Attrib(unnamedArgs = [ AttribInt32Arg validOn; AttribBoolArg(_allowMultiple); AttribBoolArg inherited])) -> - validOn, inherited - | Some _ -> - warning(Error(FSComp.SR.tcUnexpectedConditionInImportedAssembly(), mAttr)) - validOnDefault, inheritedDefault - | _ -> + if EntityHasWellKnownAttribute g WellKnownEntityAttributes.AttributeUsageAttribute tcref.Deref then + match TryFindFSharpAttribute g g.attrib_AttributeUsageAttribute tcref.Attribs with + | Some(Attrib(unnamedArgs = [ AttribInt32Arg validOn ])) -> + validOn, inheritedDefault + | Some(Attrib(unnamedArgs = [ AttribInt32Arg validOn; AttribBoolArg(_allowMultiple); AttribBoolArg inherited])) -> + validOn, inherited + | Some _ -> + warning(Error(FSComp.SR.tcUnexpectedConditionInImportedAssembly(), mAttr)) + validOnDefault, inheritedDefault + | _ -> + validOnDefault, inheritedDefault + else validOnDefault, inheritedDefault // Determine valid attribute targets diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 73ca26d1961..d0960744d94 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -11573,60 +11573,60 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option tdef let tdLayout, tdEncoding = - match TryFindFSharpAttribute g g.attrib_StructLayoutAttribute tycon.Attribs with // TODO: WELLKNOWN_ATTRIB - value extraction - | Some(Attrib(_, _, [ AttribInt32Arg layoutKind ], namedArgs, _, _, _)) -> - let decoder = AttributeDecoder namedArgs - let ilPack = decoder.FindInt32 "Pack" 0x0 - let ilSize = decoder.FindInt32 "Size" 0x0 - - let tdEncoding = - match (decoder.FindInt32 "CharSet" 0x0) with - (* enumeration values for System.Runtime.InteropServices.CharSet taken from mscorlib.il *) - | 0x03 -> ILDefaultPInvokeEncoding.Unicode - | 0x04 -> ILDefaultPInvokeEncoding.Auto - | _ -> ILDefaultPInvokeEncoding.Ansi - - let layoutInfo = - if ilPack = 0x0 && ilSize = 0x0 then - { Size = None; Pack = None } + let defaultLayout () = + match ilTypeDefKind with + | HasFlag ILTypeDefAdditionalFlags.ValueType -> + // All structs are sequential by default + // Structs with no instance fields get size 1, pack 0 + if + tycon.AllFieldsArray |> Array.exists (fun f -> not f.IsStatic) + || + // Reflection emit doesn't let us emit 'pack' and 'size' for generic structs. + // In that case we generate a dummy field instead + (cenv.options.workAroundReflectionEmitBugs && not tycon.TyparsNoRange.IsEmpty) + then + ILTypeDefLayout.Sequential { Size = None; Pack = None }, ILDefaultPInvokeEncoding.Ansi else - { - Size = Some ilSize - Pack = Some(uint16 ilPack) - } - - let tdLayout = - match layoutKind with - (* enumeration values for System.Runtime.InteropServices.LayoutKind taken from mscorlib.il *) - | 0x0 -> ILTypeDefLayout.Sequential layoutInfo - | 0x2 -> ILTypeDefLayout.Explicit layoutInfo - | _ -> ILTypeDefLayout.Auto - - tdLayout, tdEncoding - | Some(Attrib(_, _, _, _, _, _, m)) -> - errorR (Error(FSComp.SR.ilStructLayoutAttributeCouldNotBeDecoded (), m)) - ILTypeDefLayout.Auto, ILDefaultPInvokeEncoding.Ansi - - | _ when - (match ilTypeDefKind with - | HasFlag ILTypeDefAdditionalFlags.ValueType -> true - | _ -> false) - -> - - // All structs are sequential by default - // Structs with no instance fields get size 1, pack 0 - if - tycon.AllFieldsArray |> Array.exists (fun f -> not f.IsStatic) - || - // Reflection emit doesn't let us emit 'pack' and 'size' for generic structs. - // In that case we generate a dummy field instead - (cenv.options.workAroundReflectionEmitBugs && not tycon.TyparsNoRange.IsEmpty) - then - ILTypeDefLayout.Sequential { Size = None; Pack = None }, ILDefaultPInvokeEncoding.Ansi - else - ILTypeDefLayout.Sequential { Size = Some 1; Pack = Some 0us }, ILDefaultPInvokeEncoding.Ansi + ILTypeDefLayout.Sequential { Size = Some 1; Pack = Some 0us }, ILDefaultPInvokeEncoding.Ansi + | _ -> ILTypeDefLayout.Auto, ILDefaultPInvokeEncoding.Ansi + + if EntityHasWellKnownAttribute g WellKnownEntityAttributes.StructLayoutAttribute tycon then + match TryFindFSharpAttribute g g.attrib_StructLayoutAttribute tycon.Attribs with + | Some(Attrib(_, _, [ AttribInt32Arg layoutKind ], namedArgs, _, _, _)) -> + let decoder = AttributeDecoder namedArgs + let ilPack = decoder.FindInt32 "Pack" 0x0 + let ilSize = decoder.FindInt32 "Size" 0x0 + + let tdEncoding = + match (decoder.FindInt32 "CharSet" 0x0) with + (* enumeration values for System.Runtime.InteropServices.CharSet taken from mscorlib.il *) + | 0x03 -> ILDefaultPInvokeEncoding.Unicode + | 0x04 -> ILDefaultPInvokeEncoding.Auto + | _ -> ILDefaultPInvokeEncoding.Ansi + + let layoutInfo = + if ilPack = 0x0 && ilSize = 0x0 then + { Size = None; Pack = None } + else + { + Size = Some ilSize + Pack = Some(uint16 ilPack) + } - | _ -> ILTypeDefLayout.Auto, ILDefaultPInvokeEncoding.Ansi + let tdLayout = + match layoutKind with + (* enumeration values for System.Runtime.InteropServices.LayoutKind taken from mscorlib.il *) + | 0x0 -> ILTypeDefLayout.Sequential layoutInfo + | 0x2 -> ILTypeDefLayout.Explicit layoutInfo + | _ -> ILTypeDefLayout.Auto + + tdLayout, tdEncoding + | Some(Attrib(_, _, _, _, _, _, m)) -> + errorR (Error(FSComp.SR.ilStructLayoutAttributeCouldNotBeDecoded (), m)) + ILTypeDefLayout.Auto, ILDefaultPInvokeEncoding.Ansi + | _ -> defaultLayout () + else + defaultLayout () // if the type's layout is Explicit, ensure that each field has a valid offset let validateExplicit (fdef: ILFieldDef) = diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index a18912ba084..d31c778ca49 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -11879,7 +11879,10 @@ let CombineCcuContentFragments l = entity1 |> Construct.NewModifiedTycon (fun data1 -> let xml = XmlDoc.Merge entity1.XmlDoc entity2.XmlDoc { data1 with - entity_attribs = WellKnownEntityAttribs.Create(entity1.Attribs @ entity2.Attribs) + entity_attribs = + if entity2.Attribs.IsEmpty then entity1.EntityAttribs + elif entity1.Attribs.IsEmpty then entity2.EntityAttribs + else WellKnownEntityAttribs.Create(entity1.Attribs @ entity2.Attribs) entity_modul_type = MaybeLazy.Lazy (InterruptibleLazy(fun _ -> CombineModuleOrNamespaceTypes path2 entity1.ModuleOrNamespaceType entity2.ModuleOrNamespaceType)) entity_opt_data = match data1.entity_opt_data with @@ -12237,7 +12240,7 @@ let tryAddExtensionAttributeIfNotAlreadyPresentForModule match tryFindExtensionAttributeIn (tryFindExtensionAttribute g) with | None -> moduleEntity | Some extensionAttrib -> - { moduleEntity with entity_attribs = WellKnownEntityAttribs.Create(extensionAttrib :: moduleEntity.Attribs) } + { moduleEntity with entity_attribs = moduleEntity.EntityAttribs.Add(extensionAttrib, WellKnownEntityAttributes.ExtensionAttribute) } let tryAddExtensionAttributeIfNotAlreadyPresentForType (g: TcGlobals) @@ -12254,7 +12257,7 @@ let tryAddExtensionAttributeIfNotAlreadyPresentForType | Some extensionAttrib -> moduleOrNamespaceTypeAccumulator.Value.AllEntitiesByLogicalMangledName.TryFind(typeEntity.LogicalName) |> Option.iter (fun e -> - e.entity_attribs <- WellKnownEntityAttribs.Create(extensionAttrib :: e.Attribs) + e.entity_attribs <- e.EntityAttribs.Add(extensionAttrib, WellKnownEntityAttributes.ExtensionAttribute) ) typeEntity From fafa66fa7f4ad1e8ca304d0090a8645678cea1da Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Wed, 25 Feb 2026 20:52:04 +0100 Subject: [PATCH 23/71] Use WellKnownValAttribs.Empty instead of WellKnownValAttribs.Create([]) Replace WellKnownValAttribs.Create([]) with WellKnownValAttribs.Empty in NicePrint.fs, CompilerDiagnostics.fs, Symbols.fs, and TypedTreeBasics.fs. This avoids unnecessary list allocations. Also remove findings.yaml leftover artifact. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/NicePrint.fs | 2 +- src/Compiler/Driver/CompilerDiagnostics.fs | 2 +- src/Compiler/Symbols/Symbols.fs | 8 ++++---- src/Compiler/TypedTree/TypedTreeBasics.fs | 6 +++--- 4 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index b3c93f82b8a..085aaccd3f9 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -1363,7 +1363,7 @@ module PrintTastMemberOrVals = if short then for argInfo in argInfos do for _,info in argInfo do - info.Attribs <- WellKnownValAttribs.Create([]) + info.Attribs <- WellKnownValAttribs.Empty info.Name <- None let supportAccessModifiersBeforeGetSet = denv.g.langVersion.SupportsFeature Features.LanguageFeature.AllowAccessModifiersToAutoPropertiesGettersAndSetters diff --git a/src/Compiler/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index a7003c29a6e..84a412d0bcc 100644 --- a/src/Compiler/Driver/CompilerDiagnostics.fs +++ b/src/Compiler/Driver/CompilerDiagnostics.fs @@ -901,7 +901,7 @@ type Exception with tTy, { ArgReprInfo.Name = name |> Option.map (fun name -> Ident(name, range0)) - ArgReprInfo.Attribs = WellKnownValAttribs.Create([]) + ArgReprInfo.Attribs = WellKnownValAttribs.Empty ArgReprInfo.OtherRange = None }) diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs index d89b7bf2bd4..6b5a123a94b 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -2126,7 +2126,7 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = [ [ for ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, _callerInfo, nmOpt, _reflArgInfo, pty) in p.GetParamDatas(cenv.amap, range0) do // INCOMPLETENESS: Attribs is empty here, so we can't look at attributes for // either .NET or F# parameters - let argInfo: ArgReprInfo = { Name=nmOpt; Attribs=WellKnownValAttribs.Create([]); OtherRange=None } + let argInfo: ArgReprInfo = { Name=nmOpt; Attribs=WellKnownValAttribs.Empty; OtherRange=None } let m = match nmOpt with | Some v -> v.idRange @@ -2145,7 +2145,7 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = [ for ParamData(isParamArrayArg, isInArg, isOutArg, optArgInfo, _callerInfo, nmOpt, _reflArgInfo, pty) in argTys do // INCOMPLETENESS: Attribs is empty here, so we can't look at attributes for // either .NET or F# parameters - let argInfo: ArgReprInfo = { Name=nmOpt; Attribs=WellKnownValAttribs.Create([]); OtherRange=None } + let argInfo: ArgReprInfo = { Name=nmOpt; Attribs=WellKnownValAttribs.Empty; OtherRange=None } let m = match nmOpt with | Some v -> v.idRange @@ -2500,7 +2500,7 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = let nm = String.uncapitalize witnessInfo.MemberName let nm = if used.Contains nm then nm + string i else nm let m = x.DeclarationLocation - let argReprInfo : ArgReprInfo = { Attribs=WellKnownValAttribs.Create([]); Name=Some (mkSynId m nm); OtherRange=None } + let argReprInfo : ArgReprInfo = { Attribs=WellKnownValAttribs.Empty; Name=Some (mkSynId m nm); OtherRange=None } let p = FSharpParameter(cenv, paramTy, argReprInfo, None, m, false, false, false, false, true) p, (used.Add nm, i + 1)) |> fst @@ -2884,7 +2884,7 @@ type FSharpParameter(cenv, paramTy: TType, topArgInfo: ArgReprInfo, ownerOpt, m: (fun _ _ _ -> true)) new (cenv, idOpt, ty, ownerOpt, m) = - let argInfo: ArgReprInfo = { Name = idOpt; Attribs = WellKnownValAttribs.Create([]); OtherRange = None } + let argInfo: ArgReprInfo = { Name = idOpt; Attribs = WellKnownValAttribs.Empty; OtherRange = None } FSharpParameter(cenv, ty, argInfo, ownerOpt, m, false, false, false, false, false) new (cenv, ty, argInfo: ArgReprInfo, m: range) = diff --git a/src/Compiler/TypedTree/TypedTreeBasics.fs b/src/Compiler/TypedTree/TypedTreeBasics.fs index 746fd3008ad..1445fce7b8c 100644 --- a/src/Compiler/TypedTree/TypedTreeBasics.fs +++ b/src/Compiler/TypedTree/TypedTreeBasics.fs @@ -22,13 +22,13 @@ assert (sizeof = 4) /// Metadata on values (names of arguments etc.) module ValReprInfo = - let unnamedTopArg1: ArgReprInfo = { Attribs = WellKnownValAttribs.Create([]); Name = None; OtherRange = None } + let unnamedTopArg1: ArgReprInfo = { Attribs = WellKnownValAttribs.Empty; Name = None; OtherRange = None } let unnamedTopArg = [unnamedTopArg1] let unitArgData: ArgReprInfo list list = [[]] - let unnamedRetVal: ArgReprInfo = { Attribs = WellKnownValAttribs.Create([]); Name = None; OtherRange = None } + let unnamedRetVal: ArgReprInfo = { Attribs = WellKnownValAttribs.Empty; Name = None; OtherRange = None } let selfMetadata = unnamedTopArg @@ -41,7 +41,7 @@ module ValReprInfo = let InferTyparInfo (tps: Typar list) = tps |> List.map (fun tp -> TyparReprInfo(tp.Id, tp.Kind)) - let InferArgReprInfo (v: Val) : ArgReprInfo = { Attribs = WellKnownValAttribs.Create([]); Name = Some v.Id; OtherRange = None } + let InferArgReprInfo (v: Val) : ArgReprInfo = { Attribs = WellKnownValAttribs.Empty; Name = Some v.Id; OtherRange = None } let InferArgReprInfos (vs: Val list list) = ValReprInfo([], List.mapSquared InferArgReprInfo vs, unnamedRetVal) From 1f289abacfe52b35a91ff04a340719e833f49c2d Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 26 Feb 2026 17:11:17 +0100 Subject: [PATCH 24/71] deduplicate logic for bool arg attrs --- src/Compiler/AbstractIL/il.fs | 1 - src/Compiler/AbstractIL/il.fsi | 1 - .../Checking/Expressions/CheckExpressions.fs | 5 +- src/Compiler/Checking/infos.fs | 8 +- src/Compiler/TypedTree/TypedTree.fs | 2 +- src/Compiler/TypedTree/TypedTree.fsi | 2 +- src/Compiler/TypedTree/TypedTreeOps.fs | 238 +++++++----------- src/Compiler/TypedTree/TypedTreeOps.fsi | 6 +- .../AttributeUsage/AttributeUsage.fs | 62 +++++ 9 files changed, 164 insertions(+), 161 deletions(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index 5fe759c18de..ea84edf3c60 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -1321,7 +1321,6 @@ let mkILCustomAttrsComputed f = let mkILCustomAttrsReader f = ILAttributesStored.CreateReader(-1, f) -let mkILCustomAttrsReaderWithIndex idx f = ILAttributesStored.CreateReader(idx, f) type ILCodeLabel = int diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index 84c47adfff9..9a4b66eb732 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -2311,7 +2311,6 @@ val mkILCustomAttrsFromArray: ILAttribute[] -> ILAttributes val storeILCustomAttrs: ILAttributes -> ILAttributesStored val mkILCustomAttrsComputed: (unit -> ILAttribute[]) -> ILAttributesStored val internal mkILCustomAttrsReader: (int32 -> ILAttribute[]) -> ILAttributesStored -val internal mkILCustomAttrsReaderWithIndex: int32 -> (int32 -> ILAttribute[]) -> ILAttributesStored val emptyILCustomAttrs: ILAttributes val emptyILCustomAttrsStored: ILAttributesStored diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index fe99e5e9c2f..70c0b665843 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -2164,7 +2164,7 @@ module GeneralizationHelpers = // Applications of type functions are _not_ normally generalizable unless explicitly marked so | Expr.App (Expr.Val (vref, _, _), _, _, [], _) when vref.IsTypeFunction -> - HasFSharpAttribute g g.attrib_GeneralizableValueAttribute vref.Attribs // TODO: WELLKNOWN_ATTRIB + ValHasWellKnownAttribute g WellKnownValAttributes.GeneralizableValueAttribute vref.Deref | Expr.App (expr1, _, _, [], _) -> IsGeneralizableValue g expr1 | Expr.TyChoose (_, b, _) -> IsGeneralizableValue g b @@ -11147,7 +11147,8 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt | _ -> false | _ -> false - if valAttribFlags &&& (WellKnownValAttributes.DefaultValueAttribute_True ||| WellKnownValAttributes.DefaultValueAttribute_False) <> WellKnownValAttributes.None && not isZeroMethod then + let hasDefaultValueAttr = valAttribFlags &&& (WellKnownValAttributes.DefaultValueAttribute_True ||| WellKnownValAttributes.DefaultValueAttribute_False) <> WellKnownValAttributes.None + if hasDefaultValueAttr && not isZeroMethod then errorR(Error(FSComp.SR.tcDefaultValueAttributeRequiresVal(), mBinding)) let isThreadStatic = isThreadOrContextStatic g valAttribs diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index 9b31abde0d0..b03819076df 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -277,13 +277,9 @@ let CrackParamAttribsInfo g (ty: TType, argInfo: ArgReprInfo) = let attribs = argInfo.Attribs.AsList() let isParamArrayArg = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.ParamArrayAttribute argInfo let reflArgInfo = - let _ = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.ReflectedDefinitionAttribute_True argInfo - - let wa = argInfo.Attribs - - if wa.HasWellKnownAttribute(WellKnownValAttributes.ReflectedDefinitionAttribute_True) then + if ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.ReflectedDefinitionAttribute_True argInfo then ReflectedArgInfo.Quote true - elif wa.HasWellKnownAttribute(WellKnownValAttributes.ReflectedDefinitionAttribute_False) then + elif ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.ReflectedDefinitionAttribute_False argInfo then ReflectedArgInfo.Quote false else ReflectedArgInfo.None diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 934b95c23c0..659323a04b6 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -4665,7 +4665,6 @@ type WellKnownEntityAttributes = | StructLayoutAttribute = 0x4000uL | DllImportAttribute = 0x8000uL | ReflectedDefinitionAttribute = 0x10000uL - | GeneralizableValueAttribute = 0x20000uL | SkipLocalsInitAttribute = 0x40000uL | DebuggerTypeProxyAttribute = 0x80000uL | ComVisibleAttribute = 0x100000uL @@ -4764,6 +4763,7 @@ type WellKnownValAttributes = | ReflectedDefinitionAttribute_False = 0x4000000uL | DefaultValueAttribute_False = 0x8000000uL | NoDynamicInvocationAttribute_False = 0x10000000uL + | GeneralizableValueAttribute = 0x20000000uL | NotComputed = 0x8000000000000000uL /// Wraps an Attrib list together with cached WellKnownValAttributes flags for O(1) lookup. diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index c93c2f5d59e..0f1543eaaee 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -3266,7 +3266,6 @@ type WellKnownEntityAttributes = | StructLayoutAttribute = 0x4000uL | DllImportAttribute = 0x8000uL | ReflectedDefinitionAttribute = 0x10000uL - | GeneralizableValueAttribute = 0x20000uL | SkipLocalsInitAttribute = 0x40000uL | DebuggerTypeProxyAttribute = 0x80000uL | ComVisibleAttribute = 0x100000uL @@ -3333,6 +3332,7 @@ type WellKnownValAttributes = | ReflectedDefinitionAttribute_False = 0x4000000uL | DefaultValueAttribute_False = 0x8000000uL | NoDynamicInvocationAttribute_False = 0x10000000uL + | GeneralizableValueAttribute = 0x20000000uL | NotComputed = 0x8000000000000000uL /// Wraps an Attrib list together with cached WellKnownValAttributes flags for O(1) lookup. diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index d31c778ca49..f060e7cfa2d 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3617,8 +3617,7 @@ let IsILAttrib (AttribInfo (builtInAttrRef, _)) attr = isILAttrib builtInAttrRe /// Compute well-known attribute flags for an ILAttributes collection. /// This is the 'compute' callback passed to ILAttributesStored.HasWellKnownAttribute. -let computeILWellKnownFlags (g: TcGlobals) (attrs: ILAttributes) : WellKnownILAttributes = - ignore g +let computeILWellKnownFlags (_g: TcGlobals) (attrs: ILAttributes) : WellKnownILAttributes = let mutable flags = WellKnownILAttributes.None for attr in attrs.AsArray() do @@ -3700,6 +3699,30 @@ type ILFieldDef with member x.HasWellKnownAttribute(g: TcGlobals, flag: WellKnownILAttributes) = x.CustomAttrsStored.HasWellKnownAttribute(g, flag) +/// Resolve the FSharp.Core path for an attribute's type reference. +/// Returns ValueSome path for FSharp.Core attributes, calls bclDispatch for BCL attributes, ValueNone otherwise. +let inline resolveAttribPath (g: TcGlobals) (tcref: TyconRef) (bclDispatch: string[] -> unit) : string[] voption = + if not tcref.IsLocalRef then + let nlr = tcref.nlr + + if ccuEq nlr.Ccu g.fslibCcu then + ValueSome nlr.Path + else + bclDispatch nlr.Path + ValueNone + elif g.compilingFSharpCore then + match tcref.Deref.PublicPath with + | Some(PubPath pp) -> ValueSome pp + | None -> ValueNone + else + ValueNone + +/// Decode a bool-arg attribute and set the appropriate true/false flag. +let inline decodeBoolAttribFlag (attrib: Attrib) trueFlag falseFlag defaultFlag = + match attrib with + | Attrib(_, _, [ AttribBoolArg b ], _, _, _, _) -> if b then trueFlag else falseFlag + | _ -> defaultFlag + /// Compute well-known attribute flags for an Entity's Attrib list. let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEntityAttributes = let mutable flags = WellKnownEntityAttributes.None @@ -3707,53 +3730,35 @@ let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEnt for attrib in attribs do let (Attrib(tcref, _, _, _, _, _, _)) = attrib - // Resolve the path for this attribute's type. - // Non-local refs from FSharp.Core → ValueSome path - // Local refs when compilingFSharpCore → ValueSome path (via PublicPath) - // Everything else → ValueNone (system attrs handled inline, user attrs skipped) let fsharpCorePath = - if not tcref.IsLocalRef then - let nlr = tcref.nlr + resolveAttribPath g tcref (fun path -> + match path with + | [| "System"; "Runtime"; "CompilerServices"; name |] -> + match name with + | "ExtensionAttribute" -> flags <- flags ||| WellKnownEntityAttributes.ExtensionAttribute + | "IsReadOnlyAttribute" -> flags <- flags ||| WellKnownEntityAttributes.IsReadOnlyAttribute + | "SkipLocalsInitAttribute" -> flags <- flags ||| WellKnownEntityAttributes.SkipLocalsInitAttribute + | "IsByRefLikeAttribute" -> flags <- flags ||| WellKnownEntityAttributes.IsByRefLikeAttribute + | _ -> () - if ccuEq nlr.Ccu g.fslibCcu then - ValueSome nlr.Path - else - // ── System / BCL assemblies ── - match nlr.Path with - | [| "System"; "Runtime"; "CompilerServices"; name |] -> - match name with - | "ExtensionAttribute" -> flags <- flags ||| WellKnownEntityAttributes.ExtensionAttribute - | "IsReadOnlyAttribute" -> flags <- flags ||| WellKnownEntityAttributes.IsReadOnlyAttribute - | "SkipLocalsInitAttribute" -> flags <- flags ||| WellKnownEntityAttributes.SkipLocalsInitAttribute - | "IsByRefLikeAttribute" -> flags <- flags ||| WellKnownEntityAttributes.IsByRefLikeAttribute - | _ -> () - - | [| "System"; "Runtime"; "InteropServices"; name |] -> - match name with - | "StructLayoutAttribute" -> flags <- flags ||| WellKnownEntityAttributes.StructLayoutAttribute - | "DllImportAttribute" -> flags <- flags ||| WellKnownEntityAttributes.DllImportAttribute - | "ComVisibleAttribute" -> flags <- flags ||| WellKnownEntityAttributes.ComVisibleAttribute - | _ -> () - - | [| "System"; "Diagnostics"; name |] -> - match name with - | "DebuggerTypeProxyAttribute" -> flags <- flags ||| WellKnownEntityAttributes.DebuggerTypeProxyAttribute - | _ -> () - - | [| "System"; name |] -> - match name with - | "AttributeUsageAttribute" -> flags <- flags ||| WellKnownEntityAttributes.AttributeUsageAttribute - | _ -> () + | [| "System"; "Runtime"; "InteropServices"; name |] -> + match name with + | "StructLayoutAttribute" -> flags <- flags ||| WellKnownEntityAttributes.StructLayoutAttribute + | "DllImportAttribute" -> flags <- flags ||| WellKnownEntityAttributes.DllImportAttribute + | "ComVisibleAttribute" -> flags <- flags ||| WellKnownEntityAttributes.ComVisibleAttribute + | _ -> () + | [| "System"; "Diagnostics"; name |] -> + match name with + | "DebuggerTypeProxyAttribute" -> flags <- flags ||| WellKnownEntityAttributes.DebuggerTypeProxyAttribute | _ -> () - ValueNone - elif g.compilingFSharpCore then - match tcref.Deref.PublicPath with - | Some(PubPath pp) -> ValueSome pp - | None -> ValueNone - else - ValueNone + | [| "System"; name |] -> + match name with + | "AttributeUsageAttribute" -> flags <- flags ||| WellKnownEntityAttributes.AttributeUsageAttribute + | _ -> () + + | _ -> ()) // ── FSharp.Core attributes (written once, used for both paths) ── match fsharpCorePath with @@ -3761,7 +3766,10 @@ let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEnt match path with | [| "Microsoft"; "FSharp"; "Core"; name |] -> match name with - | "SealedAttribute" -> flags <- flags ||| WellKnownEntityAttributes.SealedAttribute + | "SealedAttribute" -> + match attrib with + | Attrib(_, _, [ AttribBoolArg false ], _, _, _, _) -> () + | _ -> flags <- flags ||| WellKnownEntityAttributes.SealedAttribute | "AbstractClassAttribute" -> flags <- flags ||| WellKnownEntityAttributes.AbstractClassAttribute | "RequireQualifiedAccessAttribute" -> flags <- flags ||| WellKnownEntityAttributes.RequireQualifiedAccessAttribute @@ -3778,28 +3786,12 @@ let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEnt | "ReferenceEqualityAttribute" -> flags <- flags ||| WellKnownEntityAttributes.ReferenceEqualityAttribute | "DefaultAugmentationAttribute" -> - match attrib with - | Attrib(_, _, [ AttribBoolArg b ], _, _, _, _) -> - if b then - flags <- flags ||| WellKnownEntityAttributes.DefaultAugmentationAttribute_True - else - flags <- flags ||| WellKnownEntityAttributes.DefaultAugmentationAttribute_False - | _ -> - flags <- flags ||| WellKnownEntityAttributes.DefaultAugmentationAttribute_True + flags <- flags ||| decodeBoolAttribFlag attrib WellKnownEntityAttributes.DefaultAugmentationAttribute_True WellKnownEntityAttributes.DefaultAugmentationAttribute_False WellKnownEntityAttributes.DefaultAugmentationAttribute_True | "CLIMutableAttribute" -> flags <- flags ||| WellKnownEntityAttributes.CLIMutableAttribute | "AutoSerializableAttribute" -> - match attrib with - | Attrib(_, _, [ AttribBoolArg b ], _, _, _, _) -> - if b then - flags <- flags ||| WellKnownEntityAttributes.AutoSerializableAttribute_True - else - flags <- flags ||| WellKnownEntityAttributes.AutoSerializableAttribute_False - | _ -> - flags <- flags ||| WellKnownEntityAttributes.AutoSerializableAttribute_True + flags <- flags ||| decodeBoolAttribFlag attrib WellKnownEntityAttributes.AutoSerializableAttribute_True WellKnownEntityAttributes.AutoSerializableAttribute_False WellKnownEntityAttributes.AutoSerializableAttribute_True | "ReflectedDefinitionAttribute" -> flags <- flags ||| WellKnownEntityAttributes.ReflectedDefinitionAttribute - | "GeneralizableValueAttribute" -> - flags <- flags ||| WellKnownEntityAttributes.GeneralizableValueAttribute | "AllowNullLiteralAttribute" -> flags <- flags ||| WellKnownEntityAttributes.AllowNullLiteralAttribute | "WarnOnWithoutNullArgumentAttribute" -> @@ -3871,56 +3863,42 @@ let computeValWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownValAtt let (Attrib(tcref, _, _, _, _, _, _)) = attrib let fsharpCorePath = - if not tcref.IsLocalRef then - let nlr = tcref.nlr + resolveAttribPath g tcref (fun path -> + match path with + | [| "System"; "Runtime"; "CompilerServices"; name |] -> + match name with + | "SkipLocalsInitAttribute" -> flags <- flags ||| WellKnownValAttributes.SkipLocalsInitAttribute + | "ExtensionAttribute" -> flags <- flags ||| WellKnownValAttributes.ExtensionAttribute + | "CallerMemberNameAttribute" -> + flags <- flags ||| WellKnownValAttributes.CallerMemberNameAttribute + | "CallerFilePathAttribute" -> flags <- flags ||| WellKnownValAttributes.CallerFilePathAttribute + | "CallerLineNumberAttribute" -> + flags <- flags ||| WellKnownValAttributes.CallerLineNumberAttribute + | _ -> () - if ccuEq nlr.Ccu g.fslibCcu then - ValueSome nlr.Path - else - // ── System / BCL assemblies ── - match nlr.Path with - | [| "System"; "Runtime"; "CompilerServices"; name |] -> - match name with - | "SkipLocalsInitAttribute" -> flags <- flags ||| WellKnownValAttributes.SkipLocalsInitAttribute - | "ExtensionAttribute" -> flags <- flags ||| WellKnownValAttributes.ExtensionAttribute - | "CallerMemberNameAttribute" -> - flags <- flags ||| WellKnownValAttributes.CallerMemberNameAttribute - | "CallerFilePathAttribute" -> flags <- flags ||| WellKnownValAttributes.CallerFilePathAttribute - | "CallerLineNumberAttribute" -> - flags <- flags ||| WellKnownValAttributes.CallerLineNumberAttribute - | _ -> () - - | [| "System"; "Runtime"; "InteropServices"; name |] -> - match name with - | "DllImportAttribute" -> flags <- flags ||| WellKnownValAttributes.DllImportAttribute - | "InAttribute" -> flags <- flags ||| WellKnownValAttributes.InAttribute - | "OutAttribute" -> flags <- flags ||| WellKnownValAttributes.OutAttribute - | "DefaultParameterValueAttribute" -> - flags <- flags ||| WellKnownValAttributes.DefaultParameterValueAttribute - | "OptionalAttribute" -> flags <- flags ||| WellKnownValAttributes.OptionalAttribute - | _ -> () - - | [| "System"; "Diagnostics"; name |] -> - match name with - | "ConditionalAttribute" -> flags <- flags ||| WellKnownValAttributes.ConditionalAttribute - | _ -> () - - | [| "System"; name |] -> - match name with - | "ThreadStaticAttribute" -> flags <- flags ||| WellKnownValAttributes.ThreadStaticAttribute - | "ContextStaticAttribute" -> flags <- flags ||| WellKnownValAttributes.ContextStaticAttribute - | "ParamArrayAttribute" -> flags <- flags ||| WellKnownValAttributes.ParamArrayAttribute - | _ -> () + | [| "System"; "Runtime"; "InteropServices"; name |] -> + match name with + | "DllImportAttribute" -> flags <- flags ||| WellKnownValAttributes.DllImportAttribute + | "InAttribute" -> flags <- flags ||| WellKnownValAttributes.InAttribute + | "OutAttribute" -> flags <- flags ||| WellKnownValAttributes.OutAttribute + | "DefaultParameterValueAttribute" -> + flags <- flags ||| WellKnownValAttributes.DefaultParameterValueAttribute + | "OptionalAttribute" -> flags <- flags ||| WellKnownValAttributes.OptionalAttribute + | _ -> () + | [| "System"; "Diagnostics"; name |] -> + match name with + | "ConditionalAttribute" -> flags <- flags ||| WellKnownValAttributes.ConditionalAttribute | _ -> () - ValueNone - elif g.compilingFSharpCore then - match tcref.Deref.PublicPath with - | Some(PubPath pp) -> ValueSome pp - | None -> ValueNone - else - ValueNone + | [| "System"; name |] -> + match name with + | "ThreadStaticAttribute" -> flags <- flags ||| WellKnownValAttributes.ThreadStaticAttribute + | "ContextStaticAttribute" -> flags <- flags ||| WellKnownValAttributes.ContextStaticAttribute + | "ParamArrayAttribute" -> flags <- flags ||| WellKnownValAttributes.ParamArrayAttribute + | _ -> () + + | _ -> ()) // ── FSharp.Core attributes ── match fsharpCorePath with @@ -3931,37 +3909,16 @@ let computeValWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownValAtt | "EntryPointAttribute" -> flags <- flags ||| WellKnownValAttributes.EntryPointAttribute | "LiteralAttribute" -> flags <- flags ||| WellKnownValAttributes.LiteralAttribute | "ReflectedDefinitionAttribute" -> - match attrib with - | Attrib(_, _, [ AttribBoolArg b ], _, _, _, _) -> - if b then - flags <- flags ||| WellKnownValAttributes.ReflectedDefinitionAttribute_True - else - flags <- flags ||| WellKnownValAttributes.ReflectedDefinitionAttribute_False - | _ -> - // TryFindFSharpBoolAttributeAssumeFalse semantics: no explicit arg defaults to false - flags <- flags ||| WellKnownValAttributes.ReflectedDefinitionAttribute_False + // TryFindFSharpBoolAttributeAssumeFalse semantics: no explicit arg defaults to false + flags <- flags ||| decodeBoolAttribFlag attrib WellKnownValAttributes.ReflectedDefinitionAttribute_True WellKnownValAttributes.ReflectedDefinitionAttribute_False WellKnownValAttributes.ReflectedDefinitionAttribute_False | "RequiresExplicitTypeArgumentsAttribute" -> flags <- flags ||| WellKnownValAttributes.RequiresExplicitTypeArgumentsAttribute | "DefaultValueAttribute" -> - match attrib with - | Attrib(_, _, [ AttribBoolArg b ], _, _, _, _) -> - if b then - flags <- flags ||| WellKnownValAttributes.DefaultValueAttribute_True - else - flags <- flags ||| WellKnownValAttributes.DefaultValueAttribute_False - | _ -> - flags <- flags ||| WellKnownValAttributes.DefaultValueAttribute_True + flags <- flags ||| decodeBoolAttribFlag attrib WellKnownValAttributes.DefaultValueAttribute_True WellKnownValAttributes.DefaultValueAttribute_False WellKnownValAttributes.DefaultValueAttribute_True | "VolatileFieldAttribute" -> flags <- flags ||| WellKnownValAttributes.VolatileFieldAttribute | "NoDynamicInvocationAttribute" -> - match attrib with - | Attrib(_, _, [ AttribBoolArg b ], _, _, _, _) -> - if b then - flags <- flags ||| WellKnownValAttributes.NoDynamicInvocationAttribute_True - else - flags <- flags ||| WellKnownValAttributes.NoDynamicInvocationAttribute_False - | _ -> - // TryFindFSharpBoolAttributeAssumeFalse semantics: no explicit arg defaults to false - flags <- flags ||| WellKnownValAttributes.NoDynamicInvocationAttribute_False + // TryFindFSharpBoolAttributeAssumeFalse semantics: no explicit arg defaults to false + flags <- flags ||| decodeBoolAttribFlag attrib WellKnownValAttributes.NoDynamicInvocationAttribute_True WellKnownValAttributes.NoDynamicInvocationAttribute_False WellKnownValAttributes.NoDynamicInvocationAttribute_False | "OptionalArgumentAttribute" -> flags <- flags ||| WellKnownValAttributes.OptionalArgumentAttribute | "ProjectionParameterAttribute" -> @@ -3970,6 +3927,8 @@ let computeValWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownValAtt | "StructAttribute" -> flags <- flags ||| WellKnownValAttributes.StructAttribute | "NoCompilerInliningAttribute" -> flags <- flags ||| WellKnownValAttributes.NoCompilerInliningAttribute + | "GeneralizableValueAttribute" -> + flags <- flags ||| WellKnownValAttributes.GeneralizableValueAttribute | _ -> () | _ -> () | ValueNone -> () @@ -4009,15 +3968,6 @@ let EntityTryGetBoolAttribute (g: TcGlobals) (trueFlag: WellKnownEntityAttribute elif ea.HasWellKnownAttribute(falseFlag) then Some false else Option.None -/// Query a three-state bool attribute on a Val. Returns bool option. -let ValTryGetBoolAttribute (g: TcGlobals) (trueFlag: WellKnownValAttributes) (falseFlag: WellKnownValAttributes) (v: Val) : bool option = - let _ = ValHasWellKnownAttribute g trueFlag v - let va = v.ValAttribs - - if va.HasWellKnownAttribute(trueFlag) then Some true - elif va.HasWellKnownAttribute(falseFlag) then Some false - else Option.None - /// Analyze three cases for attributes declared on type definitions: IL-declared attributes, F#-declared attributes and /// provided attributes. // diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index cc24c06554c..570674c8b00 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2375,7 +2375,7 @@ val TryFindILAttribute: BuiltinAttribInfo -> ILAttributes -> bool val TryFindILAttributeOpt: BuiltinAttribInfo option -> ILAttributes -> bool /// Compute well-known attribute flags for an ILAttributes collection. -val computeILWellKnownFlags: g: TcGlobals -> attrs: ILAttributes -> WellKnownILAttributes +val computeILWellKnownFlags: _g: TcGlobals -> attrs: ILAttributes -> WellKnownILAttributes type ILAttributesStored with @@ -2421,10 +2421,6 @@ val EntityTryGetBoolAttribute: entity: Entity -> bool option -/// Query a three-state bool attribute on a Val. Returns bool option. -val ValTryGetBoolAttribute: - g: TcGlobals -> trueFlag: WellKnownValAttributes -> falseFlag: WellKnownValAttributes -> v: Val -> bool option - val IsMatchingFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attrib -> bool val IsMatchingFSharpAttributeOpt: TcGlobals -> BuiltinAttribInfo option -> Attrib -> bool diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs index 48104bf42ef..07c8d82416b 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs @@ -975,6 +975,68 @@ type Q2 = struct end [] type Q3 = struct end + """ + |> typecheck + |> shouldSucceed + + [] + let ``Sealed(false) allows inheritance`` () = + Fsx """ +[] +type Base() = + member _.X = 1 + +type Derived() = + inherit Base() + member _.Y = 2 + +let d = Derived() +if d.X <> 1 || d.Y <> 2 then failwith "unexpected" + """ + |> compileExeAndRun + |> shouldSucceed + + [] + let ``Sealed with no arg prevents inheritance`` () = + Fsx """ +[] +type Base() = + member _.X = 1 + +type Derived() = + inherit Base() + """ + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 945, Line 7, Col 13, Line 7, Col 17, "Cannot inherit a sealed type") + ] + + [] + let ``Sealed(true) prevents inheritance`` () = + Fsx """ +[] +type Base() = + member _.X = 1 + +type Derived() = + inherit Base() + """ + |> typecheck + |> shouldFail + |> withDiagnostics [ + (Error 945, Line 7, Col 13, Line 7, Col 17, "Cannot inherit a sealed type") + ] + + [] + let ``DefaultAugmentation(false) suppresses helpers`` () = + Fsx """ +[] +type DU = A | B of int + +// Without DefaultAugmentation(false), DU would have IsA/IsB properties +// With it, only tags are available +let x = match DU.A with A -> 1 | B _ -> 2 """ |> typecheck |> shouldSucceed \ No newline at end of file From a3ba5d13222a7769e413a7b13de903f68f055f58 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 26 Feb 2026 17:53:53 +0100 Subject: [PATCH 25/71] Refactor WellKnownEntityAttribs and WellKnownValAttribs into generic WellKnownAttribs<'TItem, 'TFlags> Extract the near-identical struct implementations into a single generic struct WellKnownAttribs<'TItem, 'TFlags> defined in a separate file (WellKnownAttribs.fs/fsi) outside the module rec context. The two flag enums (WellKnownEntityAttributes, WellKnownValAttributes) are also moved to the new file to avoid FS0073 bootstrap compiler limitations with enum constraints in module rec. WellKnownEntityAttribs and WellKnownValAttribs become type aliases with companion modules for factory functions (Empty, Create, CreateWithFlags). All instance methods (HasWellKnownAttribute, AsList, Flags, Add, Append, WithRecomputedFlags) live on the generic struct and work through the type aliases unchanged. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/FSharp.Compiler.Service.fsproj | 2 + src/Compiler/TypedTree/TypedTree.fs | 166 ++------------------ src/Compiler/TypedTree/TypedTree.fsi | 114 ++------------ src/Compiler/TypedTree/WellKnownAttribs.fs | 122 ++++++++++++++ src/Compiler/TypedTree/WellKnownAttribs.fsi | 92 +++++++++++ 5 files changed, 244 insertions(+), 252 deletions(-) create mode 100644 src/Compiler/TypedTree/WellKnownAttribs.fs create mode 100644 src/Compiler/TypedTree/WellKnownAttribs.fsi diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index cc8865d2578..814e445e10c 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -327,6 +327,8 @@ + + diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 659323a04b6..5db1ad62450 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -4643,175 +4643,41 @@ type Measure = | One(range= m) -> m | RationalPower(measure= ms) -> ms.Range -/// Flags enum for well-known attributes on Entity (types and modules). -/// Used to avoid O(N) linear scans of attribute lists. -[] -type WellKnownEntityAttributes = - | None = 0uL - | RequireQualifiedAccessAttribute = 0x1uL - | AutoOpenAttribute = 0x2uL - | AbstractClassAttribute = 0x4uL - | SealedAttribute = 0x8uL - | NoEqualityAttribute = 0x10uL - | NoComparisonAttribute = 0x20uL - | StructuralEqualityAttribute = 0x40uL - | StructuralComparisonAttribute = 0x80uL - | CustomEqualityAttribute = 0x100uL - | CustomComparisonAttribute = 0x200uL - | ReferenceEqualityAttribute = 0x400uL - | DefaultAugmentationAttribute_True = 0x800uL - | CLIMutableAttribute = 0x1000uL - | AutoSerializableAttribute_True = 0x2000uL - | StructLayoutAttribute = 0x4000uL - | DllImportAttribute = 0x8000uL - | ReflectedDefinitionAttribute = 0x10000uL - | SkipLocalsInitAttribute = 0x40000uL - | DebuggerTypeProxyAttribute = 0x80000uL - | ComVisibleAttribute = 0x100000uL - | IsReadOnlyAttribute = 0x200000uL - | IsByRefLikeAttribute = 0x400000uL - | ExtensionAttribute = 0x800000uL - | AttributeUsageAttribute = 0x1000000uL - | WarnOnWithoutNullArgumentAttribute = 0x2000000uL - | AllowNullLiteralAttribute = 0x4000000uL - | ClassAttribute = 0x8000000uL - | InterfaceAttribute = 0x10000000uL - | StructAttribute = 0x20000000uL - | MeasureAttribute = 0x40000000uL - | DefaultAugmentationAttribute_False = 0x80000000uL - | AutoSerializableAttribute_False = 0x100000000uL - | NotComputed = 0x8000000000000000uL - /// Wraps an Attrib list together with cached WellKnownEntityAttributes flags for O(1) lookup. -[] -type WellKnownEntityAttribs = - val private attribs: Attrib list - val private flags: WellKnownEntityAttributes - - new(attribs: Attrib list, flags: WellKnownEntityAttributes) = { attribs = attribs; flags = flags } +type WellKnownEntityAttribs = WellKnownAttribs +module WellKnownEntityAttribs = /// Shared singleton for entities with no attributes. - static member val Empty = WellKnownEntityAttribs([], WellKnownEntityAttributes.None) - - /// Check if a specific well-known attribute flag is set. - member x.HasWellKnownAttribute(flag: WellKnownEntityAttributes) : bool = - x.flags &&& flag <> WellKnownEntityAttributes.None - - /// Get the underlying attribute list (for remap/display/serialization/full-data extraction). - member x.AsList() = x.attribs - - /// Get the current flags value. - member x.Flags = x.flags + let Empty = WellKnownAttribs([], WellKnownEntityAttributes.None) /// Create from an attribute list. If empty, flags = None. Otherwise NotComputed. - static member Create(attribs: Attrib list) = + let Create(attribs: Attrib list) = if attribs.IsEmpty then - WellKnownEntityAttribs.Empty + Empty else - WellKnownEntityAttribs(attribs, WellKnownEntityAttributes.NotComputed) + WellKnownAttribs(attribs, WellKnownEntityAttributes.NotComputed) /// Create with precomputed flags (used when flags are already known). - static member CreateWithFlags(attribs: Attrib list, flags: WellKnownEntityAttributes) = - WellKnownEntityAttribs(attribs, flags) - - /// Add a single attribute and OR-in its flag. - member x.Add(attrib: Attrib, flag: WellKnownEntityAttributes) = - WellKnownEntityAttribs(attrib :: x.attribs, x.flags ||| flag) - - /// Append attributes and OR-in flags. - member x.Append(others: Attrib list, flags: WellKnownEntityAttributes) = - WellKnownEntityAttribs(x.attribs @ others, x.flags ||| flags) - - /// Returns a copy with recomputed flags (flags set to NotComputed). - member x.WithRecomputedFlags() = - if x.attribs.IsEmpty then - WellKnownEntityAttribs.Empty - else - WellKnownEntityAttribs(x.attribs, WellKnownEntityAttributes.NotComputed) - -/// Flags enum for well-known attributes on Val (values and members). -/// Used to avoid O(N) linear scans of attribute lists. -[] -type WellKnownValAttributes = - | None = 0uL - | DllImportAttribute = 0x1uL - | EntryPointAttribute = 0x2uL - | LiteralAttribute = 0x4uL - | ConditionalAttribute = 0x8uL - | ReflectedDefinitionAttribute_True = 0x10uL - | RequiresExplicitTypeArgumentsAttribute = 0x20uL - | DefaultValueAttribute_True = 0x40uL - | SkipLocalsInitAttribute = 0x80uL - | ThreadStaticAttribute = 0x100uL - | ContextStaticAttribute = 0x200uL - | VolatileFieldAttribute = 0x400uL - | NoDynamicInvocationAttribute_True = 0x800uL - | ExtensionAttribute = 0x1000uL - | OptionalArgumentAttribute = 0x2000uL - | InAttribute = 0x4000uL - | OutAttribute = 0x8000uL - | ParamArrayAttribute = 0x10000uL - | CallerMemberNameAttribute = 0x20000uL - | CallerFilePathAttribute = 0x40000uL - | CallerLineNumberAttribute = 0x80000uL - | DefaultParameterValueAttribute = 0x100000uL - | ProjectionParameterAttribute = 0x200000uL - | InlineIfLambdaAttribute = 0x400000uL - | OptionalAttribute = 0x800000uL - | StructAttribute = 0x1000000uL - | NoCompilerInliningAttribute = 0x2000000uL - | ReflectedDefinitionAttribute_False = 0x4000000uL - | DefaultValueAttribute_False = 0x8000000uL - | NoDynamicInvocationAttribute_False = 0x10000000uL - | GeneralizableValueAttribute = 0x20000000uL - | NotComputed = 0x8000000000000000uL + let CreateWithFlags(attribs: Attrib list, flags: WellKnownEntityAttributes) = + WellKnownAttribs(attribs, flags) /// Wraps an Attrib list together with cached WellKnownValAttributes flags for O(1) lookup. -[] -type WellKnownValAttribs = - val private attribs: Attrib list - val private flags: WellKnownValAttributes - - new(attribs: Attrib list, flags: WellKnownValAttributes) = { attribs = attribs; flags = flags } +type WellKnownValAttribs = WellKnownAttribs +module WellKnownValAttribs = /// Shared singleton for vals with no attributes. - static member val Empty = WellKnownValAttribs([], WellKnownValAttributes.None) - - /// Check if a specific well-known attribute flag is set. - member x.HasWellKnownAttribute(flag: WellKnownValAttributes) : bool = - x.flags &&& flag <> WellKnownValAttributes.None - - /// Get the underlying attribute list. - member x.AsList() = x.attribs - - /// Get the current flags value. - member x.Flags = x.flags + let Empty = WellKnownAttribs([], WellKnownValAttributes.None) /// Create from an attribute list. If empty, flags = None. Otherwise NotComputed. - static member Create(attribs: Attrib list) = + let Create(attribs: Attrib list) = if attribs.IsEmpty then - WellKnownValAttribs.Empty + Empty else - WellKnownValAttribs(attribs, WellKnownValAttributes.NotComputed) + WellKnownAttribs(attribs, WellKnownValAttributes.NotComputed) /// Create with precomputed flags (used when flags are already known). - static member CreateWithFlags(attribs: Attrib list, flags: WellKnownValAttributes) = - WellKnownValAttribs(attribs, flags) - - /// Add a single attribute and OR-in its flag. - member x.Add(attrib: Attrib, flag: WellKnownValAttributes) = - WellKnownValAttribs(attrib :: x.attribs, x.flags ||| flag) - - /// Append attributes and OR-in flags. - member x.Append(others: Attrib list, flags: WellKnownValAttributes) = - WellKnownValAttribs(x.attribs @ others, x.flags ||| flags) - - /// Returns a copy with recomputed flags (flags set to NotComputed). - member x.WithRecomputedFlags() = - if x.attribs.IsEmpty then - WellKnownValAttribs.Empty - else - WellKnownValAttribs(x.attribs, WellKnownValAttributes.NotComputed) + let CreateWithFlags(attribs: Attrib list, flags: WellKnownValAttributes) = + WellKnownAttribs(attribs, flags) type Attribs = Attrib list diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index 0f1543eaaee..b4d56a72f75 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -3245,111 +3245,21 @@ type Measure = member Range: range -/// Flags enum for well-known attributes on Entity (types and modules). -[] -type WellKnownEntityAttributes = - | None = 0uL - | RequireQualifiedAccessAttribute = 0x1uL - | AutoOpenAttribute = 0x2uL - | AbstractClassAttribute = 0x4uL - | SealedAttribute = 0x8uL - | NoEqualityAttribute = 0x10uL - | NoComparisonAttribute = 0x20uL - | StructuralEqualityAttribute = 0x40uL - | StructuralComparisonAttribute = 0x80uL - | CustomEqualityAttribute = 0x100uL - | CustomComparisonAttribute = 0x200uL - | ReferenceEqualityAttribute = 0x400uL - | DefaultAugmentationAttribute_True = 0x800uL - | CLIMutableAttribute = 0x1000uL - | AutoSerializableAttribute_True = 0x2000uL - | StructLayoutAttribute = 0x4000uL - | DllImportAttribute = 0x8000uL - | ReflectedDefinitionAttribute = 0x10000uL - | SkipLocalsInitAttribute = 0x40000uL - | DebuggerTypeProxyAttribute = 0x80000uL - | ComVisibleAttribute = 0x100000uL - | IsReadOnlyAttribute = 0x200000uL - | IsByRefLikeAttribute = 0x400000uL - | ExtensionAttribute = 0x800000uL - | AttributeUsageAttribute = 0x1000000uL - | WarnOnWithoutNullArgumentAttribute = 0x2000000uL - | AllowNullLiteralAttribute = 0x4000000uL - | ClassAttribute = 0x8000000uL - | InterfaceAttribute = 0x10000000uL - | StructAttribute = 0x20000000uL - | MeasureAttribute = 0x40000000uL - | DefaultAugmentationAttribute_False = 0x80000000uL - | AutoSerializableAttribute_False = 0x100000000uL - | NotComputed = 0x8000000000000000uL - /// Wraps an Attrib list together with cached WellKnownEntityAttributes flags for O(1) lookup. -[] -type WellKnownEntityAttribs = - val private attribs: Attrib list - val private flags: WellKnownEntityAttributes - new: attribs: Attrib list * flags: WellKnownEntityAttributes -> WellKnownEntityAttribs - static member Empty: WellKnownEntityAttribs - member HasWellKnownAttribute: flag: WellKnownEntityAttributes -> bool - member AsList: unit -> Attrib list - member Flags: WellKnownEntityAttributes - static member Create: attribs: Attrib list -> WellKnownEntityAttribs - static member CreateWithFlags: attribs: Attrib list * flags: WellKnownEntityAttributes -> WellKnownEntityAttribs - member Add: attrib: Attrib * flag: WellKnownEntityAttributes -> WellKnownEntityAttribs - member Append: others: Attrib list * flags: WellKnownEntityAttributes -> WellKnownEntityAttribs - member WithRecomputedFlags: unit -> WellKnownEntityAttribs - -/// Flags enum for well-known attributes on Val (values and members). -[] -type WellKnownValAttributes = - | None = 0uL - | DllImportAttribute = 0x1uL - | EntryPointAttribute = 0x2uL - | LiteralAttribute = 0x4uL - | ConditionalAttribute = 0x8uL - | ReflectedDefinitionAttribute_True = 0x10uL - | RequiresExplicitTypeArgumentsAttribute = 0x20uL - | DefaultValueAttribute_True = 0x40uL - | SkipLocalsInitAttribute = 0x80uL - | ThreadStaticAttribute = 0x100uL - | ContextStaticAttribute = 0x200uL - | VolatileFieldAttribute = 0x400uL - | NoDynamicInvocationAttribute_True = 0x800uL - | ExtensionAttribute = 0x1000uL - | OptionalArgumentAttribute = 0x2000uL - | InAttribute = 0x4000uL - | OutAttribute = 0x8000uL - | ParamArrayAttribute = 0x10000uL - | CallerMemberNameAttribute = 0x20000uL - | CallerFilePathAttribute = 0x40000uL - | CallerLineNumberAttribute = 0x80000uL - | DefaultParameterValueAttribute = 0x100000uL - | ProjectionParameterAttribute = 0x200000uL - | InlineIfLambdaAttribute = 0x400000uL - | OptionalAttribute = 0x800000uL - | StructAttribute = 0x1000000uL - | NoCompilerInliningAttribute = 0x2000000uL - | ReflectedDefinitionAttribute_False = 0x4000000uL - | DefaultValueAttribute_False = 0x8000000uL - | NoDynamicInvocationAttribute_False = 0x10000000uL - | GeneralizableValueAttribute = 0x20000000uL - | NotComputed = 0x8000000000000000uL +type WellKnownEntityAttribs = WellKnownAttribs + +module WellKnownEntityAttribs = + val Empty: WellKnownEntityAttribs + val Create: attribs: Attrib list -> WellKnownEntityAttribs + val CreateWithFlags: attribs: Attrib list * flags: WellKnownEntityAttributes -> WellKnownEntityAttribs /// Wraps an Attrib list together with cached WellKnownValAttributes flags for O(1) lookup. -[] -type WellKnownValAttribs = - val private attribs: Attrib list - val private flags: WellKnownValAttributes - new: attribs: Attrib list * flags: WellKnownValAttributes -> WellKnownValAttribs - static member Empty: WellKnownValAttribs - member HasWellKnownAttribute: flag: WellKnownValAttributes -> bool - member AsList: unit -> Attrib list - member Flags: WellKnownValAttributes - static member Create: attribs: Attrib list -> WellKnownValAttribs - static member CreateWithFlags: attribs: Attrib list * flags: WellKnownValAttributes -> WellKnownValAttribs - member Add: attrib: Attrib * flag: WellKnownValAttributes -> WellKnownValAttribs - member Append: others: Attrib list * flags: WellKnownValAttributes -> WellKnownValAttribs - member WithRecomputedFlags: unit -> WellKnownValAttribs +type WellKnownValAttribs = WellKnownAttribs + +module WellKnownValAttribs = + val Empty: WellKnownValAttribs + val Create: attribs: Attrib list -> WellKnownValAttribs + val CreateWithFlags: attribs: Attrib list * flags: WellKnownValAttributes -> WellKnownValAttribs type Attribs = Attrib list diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fs b/src/Compiler/TypedTree/WellKnownAttribs.fs new file mode 100644 index 00000000000..1c602aadb35 --- /dev/null +++ b/src/Compiler/TypedTree/WellKnownAttribs.fs @@ -0,0 +1,122 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +/// Flags enums and generic wrapper for well-known attribute flags. +namespace FSharp.Compiler + +/// Flags enum for well-known attributes on Entity (types and modules). +/// Used to avoid O(N) linear scans of attribute lists. +[] +type internal WellKnownEntityAttributes = + | None = 0uL + | RequireQualifiedAccessAttribute = (1uL <<< 0) + | AutoOpenAttribute = (1uL <<< 1) + | AbstractClassAttribute = (1uL <<< 2) + | SealedAttribute = (1uL <<< 3) + | NoEqualityAttribute = (1uL <<< 4) + | NoComparisonAttribute = (1uL <<< 5) + | StructuralEqualityAttribute = (1uL <<< 6) + | StructuralComparisonAttribute = (1uL <<< 7) + | CustomEqualityAttribute = (1uL <<< 8) + | CustomComparisonAttribute = (1uL <<< 9) + | ReferenceEqualityAttribute = (1uL <<< 10) + | DefaultAugmentationAttribute_True = (1uL <<< 11) + | CLIMutableAttribute = (1uL <<< 12) + | AutoSerializableAttribute_True = (1uL <<< 13) + | StructLayoutAttribute = (1uL <<< 14) + | DllImportAttribute = (1uL <<< 15) + | ReflectedDefinitionAttribute = (1uL <<< 16) + | SkipLocalsInitAttribute = (1uL <<< 18) + | DebuggerTypeProxyAttribute = (1uL <<< 19) + | ComVisibleAttribute = (1uL <<< 20) + | IsReadOnlyAttribute = (1uL <<< 21) + | IsByRefLikeAttribute = (1uL <<< 22) + | ExtensionAttribute = (1uL <<< 23) + | AttributeUsageAttribute = (1uL <<< 24) + | WarnOnWithoutNullArgumentAttribute = (1uL <<< 25) + | AllowNullLiteralAttribute = (1uL <<< 26) + | ClassAttribute = (1uL <<< 27) + | InterfaceAttribute = (1uL <<< 28) + | StructAttribute = (1uL <<< 29) + | MeasureAttribute = (1uL <<< 30) + | DefaultAugmentationAttribute_False = (1uL <<< 31) + | AutoSerializableAttribute_False = (1uL <<< 32) + | NotComputed = (1uL <<< 63) + +/// Flags enum for well-known attributes on Val (values and members). +/// Used to avoid O(N) linear scans of attribute lists. +[] +type internal WellKnownValAttributes = + | None = 0uL + | DllImportAttribute = (1uL <<< 0) + | EntryPointAttribute = (1uL <<< 1) + | LiteralAttribute = (1uL <<< 2) + | ConditionalAttribute = (1uL <<< 3) + | ReflectedDefinitionAttribute_True = (1uL <<< 4) + | RequiresExplicitTypeArgumentsAttribute = (1uL <<< 5) + | DefaultValueAttribute_True = (1uL <<< 6) + | SkipLocalsInitAttribute = (1uL <<< 7) + | ThreadStaticAttribute = (1uL <<< 8) + | ContextStaticAttribute = (1uL <<< 9) + | VolatileFieldAttribute = (1uL <<< 10) + | NoDynamicInvocationAttribute_True = (1uL <<< 11) + | ExtensionAttribute = (1uL <<< 12) + | OptionalArgumentAttribute = (1uL <<< 13) + | InAttribute = (1uL <<< 14) + | OutAttribute = (1uL <<< 15) + | ParamArrayAttribute = (1uL <<< 16) + | CallerMemberNameAttribute = (1uL <<< 17) + | CallerFilePathAttribute = (1uL <<< 18) + | CallerLineNumberAttribute = (1uL <<< 19) + | DefaultParameterValueAttribute = (1uL <<< 20) + | ProjectionParameterAttribute = (1uL <<< 21) + | InlineIfLambdaAttribute = (1uL <<< 22) + | OptionalAttribute = (1uL <<< 23) + | StructAttribute = (1uL <<< 24) + | NoCompilerInliningAttribute = (1uL <<< 25) + | ReflectedDefinitionAttribute_False = (1uL <<< 26) + | DefaultValueAttribute_False = (1uL <<< 27) + | NoDynamicInvocationAttribute_False = (1uL <<< 28) + | GeneralizableValueAttribute = (1uL <<< 29) + | NotComputed = (1uL <<< 63) + +/// Generic wrapper for an item list together with cached well-known attribute flags. +/// Used for O(1) lookup of well-known attributes on entities and vals. +[] +type internal WellKnownAttribs<'TItem, 'TFlags when 'TFlags: enum> = + val private attribs: 'TItem list + val private flags: 'TFlags + + new(attribs: 'TItem list, flags: 'TFlags) = { attribs = attribs; flags = flags } + + /// Check if a specific well-known attribute flag is set. + member x.HasWellKnownAttribute(flag: 'TFlags) : bool = + let f = LanguagePrimitives.EnumToValue x.flags + let v = LanguagePrimitives.EnumToValue flag + f &&& v <> 0uL + + /// Get the underlying attribute list (for remap/display/serialization/full-data extraction). + member x.AsList() = x.attribs + + /// Get the current flags value. + member x.Flags = x.flags + + /// Add a single item and OR-in its flag. + member x.Add(attrib: 'TItem, flag: 'TFlags) = + let combined = + LanguagePrimitives.EnumOfValue(LanguagePrimitives.EnumToValue x.flags ||| LanguagePrimitives.EnumToValue flag) + + WellKnownAttribs<'TItem, 'TFlags>(attrib :: x.attribs, combined) + + /// Append items and OR-in flags. + member x.Append(others: 'TItem list, flags: 'TFlags) = + let combined = + LanguagePrimitives.EnumOfValue(LanguagePrimitives.EnumToValue x.flags ||| LanguagePrimitives.EnumToValue flags) + + WellKnownAttribs<'TItem, 'TFlags>(x.attribs @ others, combined) + + /// Returns a copy with recomputed flags (flags set to NotComputed, i.e. bit 63). + member x.WithRecomputedFlags() = + if x.attribs.IsEmpty then + WellKnownAttribs<'TItem, 'TFlags>([], LanguagePrimitives.EnumOfValue 0uL) + else + WellKnownAttribs<'TItem, 'TFlags>(x.attribs, LanguagePrimitives.EnumOfValue(1uL <<< 63)) diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fsi b/src/Compiler/TypedTree/WellKnownAttribs.fsi new file mode 100644 index 00000000000..bfd96846334 --- /dev/null +++ b/src/Compiler/TypedTree/WellKnownAttribs.fsi @@ -0,0 +1,92 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +/// Flags enums and generic wrapper for well-known attribute flags. +namespace FSharp.Compiler + +/// Flags enum for well-known attributes on Entity (types and modules). +[] +type internal WellKnownEntityAttributes = + | None = 0uL + | RequireQualifiedAccessAttribute = (1uL <<< 0) + | AutoOpenAttribute = (1uL <<< 1) + | AbstractClassAttribute = (1uL <<< 2) + | SealedAttribute = (1uL <<< 3) + | NoEqualityAttribute = (1uL <<< 4) + | NoComparisonAttribute = (1uL <<< 5) + | StructuralEqualityAttribute = (1uL <<< 6) + | StructuralComparisonAttribute = (1uL <<< 7) + | CustomEqualityAttribute = (1uL <<< 8) + | CustomComparisonAttribute = (1uL <<< 9) + | ReferenceEqualityAttribute = (1uL <<< 10) + | DefaultAugmentationAttribute_True = (1uL <<< 11) + | CLIMutableAttribute = (1uL <<< 12) + | AutoSerializableAttribute_True = (1uL <<< 13) + | StructLayoutAttribute = (1uL <<< 14) + | DllImportAttribute = (1uL <<< 15) + | ReflectedDefinitionAttribute = (1uL <<< 16) + | SkipLocalsInitAttribute = (1uL <<< 18) + | DebuggerTypeProxyAttribute = (1uL <<< 19) + | ComVisibleAttribute = (1uL <<< 20) + | IsReadOnlyAttribute = (1uL <<< 21) + | IsByRefLikeAttribute = (1uL <<< 22) + | ExtensionAttribute = (1uL <<< 23) + | AttributeUsageAttribute = (1uL <<< 24) + | WarnOnWithoutNullArgumentAttribute = (1uL <<< 25) + | AllowNullLiteralAttribute = (1uL <<< 26) + | ClassAttribute = (1uL <<< 27) + | InterfaceAttribute = (1uL <<< 28) + | StructAttribute = (1uL <<< 29) + | MeasureAttribute = (1uL <<< 30) + | DefaultAugmentationAttribute_False = (1uL <<< 31) + | AutoSerializableAttribute_False = (1uL <<< 32) + | NotComputed = (1uL <<< 63) + +/// Flags enum for well-known attributes on Val (values and members). +[] +type internal WellKnownValAttributes = + | None = 0uL + | DllImportAttribute = (1uL <<< 0) + | EntryPointAttribute = (1uL <<< 1) + | LiteralAttribute = (1uL <<< 2) + | ConditionalAttribute = (1uL <<< 3) + | ReflectedDefinitionAttribute_True = (1uL <<< 4) + | RequiresExplicitTypeArgumentsAttribute = (1uL <<< 5) + | DefaultValueAttribute_True = (1uL <<< 6) + | SkipLocalsInitAttribute = (1uL <<< 7) + | ThreadStaticAttribute = (1uL <<< 8) + | ContextStaticAttribute = (1uL <<< 9) + | VolatileFieldAttribute = (1uL <<< 10) + | NoDynamicInvocationAttribute_True = (1uL <<< 11) + | ExtensionAttribute = (1uL <<< 12) + | OptionalArgumentAttribute = (1uL <<< 13) + | InAttribute = (1uL <<< 14) + | OutAttribute = (1uL <<< 15) + | ParamArrayAttribute = (1uL <<< 16) + | CallerMemberNameAttribute = (1uL <<< 17) + | CallerFilePathAttribute = (1uL <<< 18) + | CallerLineNumberAttribute = (1uL <<< 19) + | DefaultParameterValueAttribute = (1uL <<< 20) + | ProjectionParameterAttribute = (1uL <<< 21) + | InlineIfLambdaAttribute = (1uL <<< 22) + | OptionalAttribute = (1uL <<< 23) + | StructAttribute = (1uL <<< 24) + | NoCompilerInliningAttribute = (1uL <<< 25) + | ReflectedDefinitionAttribute_False = (1uL <<< 26) + | DefaultValueAttribute_False = (1uL <<< 27) + | NoDynamicInvocationAttribute_False = (1uL <<< 28) + | GeneralizableValueAttribute = (1uL <<< 29) + | NotComputed = (1uL <<< 63) + +/// Generic wrapper for an item list together with cached well-known attribute flags. +/// Used for O(1) lookup of well-known attributes on entities and vals. +[] +type internal WellKnownAttribs<'TItem, 'TFlags when 'TFlags: enum> = + val private attribs: 'TItem list + val private flags: 'TFlags + new: attribs: 'TItem list * flags: 'TFlags -> WellKnownAttribs<'TItem, 'TFlags> + member HasWellKnownAttribute: flag: 'TFlags -> bool + member AsList: unit -> 'TItem list + member Flags: 'TFlags + member Add: attrib: 'TItem * flag: 'TFlags -> WellKnownAttribs<'TItem, 'TFlags> + member Append: others: 'TItem list * flags: 'TFlags -> WellKnownAttribs<'TItem, 'TFlags> + member WithRecomputedFlags: unit -> WellKnownAttribs<'TItem, 'TFlags> From c9b08af14c0bd84678328a80bdf254a0aeb3cad2 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 27 Feb 2026 11:44:22 +0100 Subject: [PATCH 26/71] Migrate 10 additional attribute callsites to cached well-known flags - DllImport: IlxGen.IsValRefIsDllImport and TailCallChecks to ValHasWellKnownAttribute - CLIEventAttribute: Add flag, add ValCompileAsEvent, migrate 4 val-based callers - ComVisibleAttribute: Split into True/False flags, migrate IlxGen bool check - ComImportAttribute: Add True flag, migrate isComInteropTy - CompilationRepresentation: Add ModuleSuffix/PermitNull/Instance/Static entity flags, migrate TyconHasUseNullAsTrueValueAttribute - ObsoleteAttribute: Add to WellKnownILAttributes + WellKnownEntityAttributes, add CheckILAttributesForUnseenStored using O(1) flag check, migrate NameResolution.IsTyconUnseenObsoleteSpec Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/AbstractIL/il.fs | 45 ++++++----- src/Compiler/AbstractIL/il.fsi | 41 +++++----- src/Compiler/Checking/AttributeChecking.fs | 11 ++- src/Compiler/Checking/AttributeChecking.fsi | 2 + src/Compiler/Checking/CheckDeclarations.fs | 17 ++-- .../Checking/Expressions/CheckExpressions.fs | 2 +- src/Compiler/Checking/NameResolution.fs | 2 +- src/Compiler/Checking/PostInferenceChecks.fs | 3 +- src/Compiler/Checking/TailCallChecks.fs | 2 +- src/Compiler/Checking/infos.fs | 2 +- src/Compiler/CodeGen/IlxGen.fs | 11 ++- src/Compiler/TypedTree/TypedTreeOps.fs | 77 ++++++++++++------- src/Compiler/TypedTree/TypedTreeOps.fsi | 5 +- src/Compiler/TypedTree/WellKnownAttribs.fs | 11 ++- src/Compiler/TypedTree/WellKnownAttribs.fsi | 11 ++- .../AttributeUsage/AttributeUsage.fs | 8 +- .../CompilerCompatApp/Program.fs | 16 ++++ .../CompilerCompatLib/Library.fs | 27 ++++++- 18 files changed, 191 insertions(+), 102 deletions(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index ea84edf3c60..98d9a50e1ec 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -1232,26 +1232,27 @@ type ILAttributes(array: ILAttribute[]) = [] type WellKnownILAttributes = | None = 0u - | IsReadOnlyAttribute = 0x1u - | IsUnmanagedAttribute = 0x2u - | IsByRefLikeAttribute = 0x4u - | ExtensionAttribute = 0x8u - | NullableAttribute = 0x10u - | ParamArrayAttribute = 0x20u - | AllowNullLiteralAttribute = 0x40u - | ReflectedDefinitionAttribute = 0x80u - | AutoOpenAttribute = 0x100u - | InternalsVisibleToAttribute = 0x200u - | CallerMemberNameAttribute = 0x400u - | CallerFilePathAttribute = 0x800u - | CallerLineNumberAttribute = 0x1000u - | IDispatchConstantAttribute = 0x2000u - | IUnknownConstantAttribute = 0x4000u - | RequiresLocationAttribute = 0x8000u - | SetsRequiredMembersAttribute = 0x10000u - | NoEagerConstraintApplicationAttribute = 0x20000u - | DefaultMemberAttribute = 0x40000u - | NotComputed = 0x80000000u + | IsReadOnlyAttribute = (1u <<< 0) + | IsUnmanagedAttribute = (1u <<< 1) + | IsByRefLikeAttribute = (1u <<< 2) + | ExtensionAttribute = (1u <<< 3) + | NullableAttribute = (1u <<< 4) + | ParamArrayAttribute = (1u <<< 5) + | AllowNullLiteralAttribute = (1u <<< 6) + | ReflectedDefinitionAttribute = (1u <<< 7) + | AutoOpenAttribute = (1u <<< 8) + | InternalsVisibleToAttribute = (1u <<< 9) + | CallerMemberNameAttribute = (1u <<< 10) + | CallerFilePathAttribute = (1u <<< 11) + | CallerLineNumberAttribute = (1u <<< 12) + | IDispatchConstantAttribute = (1u <<< 13) + | IUnknownConstantAttribute = (1u <<< 14) + | RequiresLocationAttribute = (1u <<< 15) + | SetsRequiredMembersAttribute = (1u <<< 16) + | NoEagerConstraintApplicationAttribute = (1u <<< 17) + | DefaultMemberAttribute = (1u <<< 18) + | ObsoleteAttribute = (1u <<< 19) + | NotComputed = (1u <<< 31) type internal ILAttributesStoredRepr = | Reader of (int32 -> ILAttribute[]) @@ -1259,7 +1260,10 @@ type internal ILAttributesStoredRepr = [] type ILAttributesStored private (metadataIndex: int32, initial: ILAttributesStoredRepr) = + [] let mutable repr = initial + + [] let mutable wellKnownFlags = WellKnownILAttributes.NotComputed member _.MetadataIndex = metadataIndex @@ -1321,7 +1325,6 @@ let mkILCustomAttrsComputed f = let mkILCustomAttrsReader f = ILAttributesStored.CreateReader(-1, f) - type ILCodeLabel = int // -------------------------------------------------------------------- diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index 9a4b66eb732..26894311263 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -881,26 +881,27 @@ type ILAttributes = [] type WellKnownILAttributes = | None = 0u - | IsReadOnlyAttribute = 0x1u - | IsUnmanagedAttribute = 0x2u - | IsByRefLikeAttribute = 0x4u - | ExtensionAttribute = 0x8u - | NullableAttribute = 0x10u - | ParamArrayAttribute = 0x20u - | AllowNullLiteralAttribute = 0x40u - | ReflectedDefinitionAttribute = 0x80u - | AutoOpenAttribute = 0x100u - | InternalsVisibleToAttribute = 0x200u - | CallerMemberNameAttribute = 0x400u - | CallerFilePathAttribute = 0x800u - | CallerLineNumberAttribute = 0x1000u - | IDispatchConstantAttribute = 0x2000u - | IUnknownConstantAttribute = 0x4000u - | RequiresLocationAttribute = 0x8000u - | SetsRequiredMembersAttribute = 0x10000u - | NoEagerConstraintApplicationAttribute = 0x20000u - | DefaultMemberAttribute = 0x40000u - | NotComputed = 0x80000000u + | IsReadOnlyAttribute = (1u <<< 0) + | IsUnmanagedAttribute = (1u <<< 1) + | IsByRefLikeAttribute = (1u <<< 2) + | ExtensionAttribute = (1u <<< 3) + | NullableAttribute = (1u <<< 4) + | ParamArrayAttribute = (1u <<< 5) + | AllowNullLiteralAttribute = (1u <<< 6) + | ReflectedDefinitionAttribute = (1u <<< 7) + | AutoOpenAttribute = (1u <<< 8) + | InternalsVisibleToAttribute = (1u <<< 9) + | CallerMemberNameAttribute = (1u <<< 10) + | CallerFilePathAttribute = (1u <<< 11) + | CallerLineNumberAttribute = (1u <<< 12) + | IDispatchConstantAttribute = (1u <<< 13) + | IUnknownConstantAttribute = (1u <<< 14) + | RequiresLocationAttribute = (1u <<< 15) + | SetsRequiredMembersAttribute = (1u <<< 16) + | NoEagerConstraintApplicationAttribute = (1u <<< 17) + | DefaultMemberAttribute = (1u <<< 18) + | ObsoleteAttribute = (1u <<< 19) + | NotComputed = (1u <<< 31) /// Represents the efficiency-oriented storage of ILAttributes in another item. [] diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index ff9d19b275d..6a7b46d1de0 100755 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -438,14 +438,19 @@ let private CheckProvidedAttributes (g: TcGlobals) m (provAttribs: Tainted not (Option.isSome (TryDecodeILAttribute isByRefLikeTref cattrs)) diff --git a/src/Compiler/Checking/AttributeChecking.fsi b/src/Compiler/Checking/AttributeChecking.fsi index 8a9f0742a23..13c990d7c17 100644 --- a/src/Compiler/Checking/AttributeChecking.fsi +++ b/src/Compiler/Checking/AttributeChecking.fsi @@ -64,6 +64,8 @@ val CheckFSharpAttributes: g: TcGlobals -> attribs: Attrib list -> m: range -> O val CheckILAttributesForUnseen: g: TcGlobals -> cattrs: ILAttributes -> _m: 'a -> bool +val CheckILAttributesForUnseenStored: g: TcGlobals -> cattrsStored: ILAttributesStored -> _m: 'a -> bool + val CheckFSharpAttributesForHidden: g: TcGlobals -> attribs: Attrib list -> bool val CheckFSharpAttributesForObsolete: g: TcGlobals -> attribs: Attrib list -> bool diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index e7a1b0bb64d..bb6f69b599a 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -2548,12 +2548,13 @@ module EstablishTypeDefinitionCores = else typars.Length mkSynId id.idRange (if erasedArity = 0 then id.idText else id.idText + "`" + string erasedArity) - let private GetTyconAttribs g attrs = - let hasClassAttr = HasFSharpAttribute g g.attrib_ClassAttribute attrs - let hasAbstractClassAttr = HasFSharpAttribute g g.attrib_AbstractClassAttribute attrs - let hasInterfaceAttr = HasFSharpAttribute g g.attrib_InterfaceAttribute attrs - let hasStructAttr = HasFSharpAttribute g g.attrib_StructAttribute attrs - let hasMeasureAttr = HasFSharpAttribute g g.attrib_MeasureAttribute attrs + let private GetTyconAttribs g attrs = + let flags = computeEntityWellKnownFlags g attrs + let hasClassAttr = flags &&& WellKnownEntityAttributes.ClassAttribute <> WellKnownEntityAttributes.None + let hasAbstractClassAttr = flags &&& WellKnownEntityAttributes.AbstractClassAttribute <> WellKnownEntityAttributes.None + let hasInterfaceAttr = flags &&& WellKnownEntityAttributes.InterfaceAttribute <> WellKnownEntityAttributes.None + let hasStructAttr = flags &&& WellKnownEntityAttributes.StructAttribute <> WellKnownEntityAttributes.None + let hasMeasureAttr = flags &&& WellKnownEntityAttributes.MeasureAttribute <> WellKnownEntityAttributes.None (hasClassAttr, hasAbstractClassAttr, hasInterfaceAttr, hasStructAttr, hasMeasureAttr) //------------------------------------------------------------------------- @@ -2852,8 +2853,8 @@ module EstablishTypeDefinitionCores = // Allow failure of constructor resolution because Vals for members in the same recursive group are not yet available let attrs, getFinalAttrs = TcAttributesCanFail cenv envinner AttributeTargets.TyconDecl synAttrs let entityFlags = computeEntityWellKnownFlags g attrs - let hasMeasureAttr = HasFSharpAttribute g g.attrib_MeasureAttribute attrs - let hasStructAttr = HasFSharpAttribute g g.attrib_StructAttribute attrs + let hasMeasureAttr = entityFlags &&& WellKnownEntityAttributes.MeasureAttribute <> WellKnownEntityAttributes.None + let hasStructAttr = entityFlags &&& WellKnownEntityAttributes.StructAttribute <> WellKnownEntityAttributes.None let hasCLIMutable = entityFlags &&& WellKnownEntityAttributes.CLIMutableAttribute <> WellKnownEntityAttributes.None let hasAllowNullLiteralAttr = entityFlags &&& WellKnownEntityAttributes.AllowNullLiteralAttribute <> WellKnownEntityAttributes.None let hasSealedAttr = entityFlags &&& WellKnownEntityAttributes.SealedAttribute <> WellKnownEntityAttributes.None diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 70c0b665843..7a0d8bf85f4 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -11151,7 +11151,7 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt if hasDefaultValueAttr && not isZeroMethod then errorR(Error(FSComp.SR.tcDefaultValueAttributeRequiresVal(), mBinding)) - let isThreadStatic = isThreadOrContextStatic g valAttribs + let isThreadStatic = valAttribFlags &&& (WellKnownValAttributes.ThreadStaticAttribute ||| WellKnownValAttributes.ContextStaticAttribute) <> WellKnownValAttributes.None if isThreadStatic then errorR(DeprecatedThreadStaticBindingWarning mBinding) if isVolatile then diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index d5528b43fb2..52fe1703f2e 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -4315,7 +4315,7 @@ let IsTyconUnseenObsoleteSpec ad g amap m (x: TyconRef) allowObsolete = not (IsEntityAccessible amap m ad x) || ((not allowObsolete) && (if x.IsILTycon then - CheckILAttributesForUnseen g x.ILTyconRawMetadata.CustomAttrs m + CheckILAttributesForUnseenStored g x.ILTyconRawMetadata.CustomAttrsStored m else CheckFSharpAttributesForUnseen g x.Attribs m allowObsolete)) diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index c2d6eea4652..3f2fa5db139 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -2119,8 +2119,7 @@ and CheckBinding cenv env alwaysCheckNoReraise ctxt (TBind(v, bindRhs, _) as bin (// Check the attributes on any enclosing module env.reflect || // Check the attributes on the value - ValHasWellKnownAttribute g WellKnownValAttributes.ReflectedDefinitionAttribute_True v || - ValHasWellKnownAttribute g WellKnownValAttributes.ReflectedDefinitionAttribute_False v || + ValHasWellKnownAttribute g (WellKnownValAttributes.ReflectedDefinitionAttribute_True ||| WellKnownValAttributes.ReflectedDefinitionAttribute_False) v || // Also check the enclosing type for members - for historical reasons, in the TAST member values // are stored in the entity that encloses the type, hence we will not have noticed the ReflectedDefinition // on the enclosing type at this point. diff --git a/src/Compiler/Checking/TailCallChecks.fs b/src/Compiler/Checking/TailCallChecks.fs index 6a687add26b..f1bb333e28f 100644 --- a/src/Compiler/Checking/TailCallChecks.fs +++ b/src/Compiler/Checking/TailCallChecks.fs @@ -63,7 +63,7 @@ type TailCall = | TailCall.No -> TailCall.No let IsValRefIsDllImport g (vref: ValRef) = - vref.Attribs |> HasFSharpAttributeOpt g g.attrib_DllImportAttribute + ValHasWellKnownAttribute g WellKnownValAttributes.DllImportAttribute vref.Deref type cenv = { diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index b03819076df..3fdfa6e2cdd 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -30,7 +30,7 @@ open FSharp.Compiler.TypeProviders type ValRef with /// Indicates if an F#-declared function or member value is a CLIEvent property compiled as a .NET event member x.IsFSharpEventProperty g = - x.IsMember && CompileAsEvent g x.Attribs && not x.IsExtensionMember + x.IsMember && ValCompileAsEvent g x.Deref && not x.IsExtensionMember /// Check if an F#-declared member value is a virtual method member vref.IsVirtualMember = diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index d0960744d94..ec4a69a6b5c 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -1396,7 +1396,7 @@ let TryStorageForWitness (_g: TcGlobals) eenv (w: TraitWitnessInfo) = | _ -> None let IsValRefIsDllImport g (vref: ValRef) = - vref.Attribs |> HasFSharpAttributeOpt g g.attrib_DllImportAttribute + ValHasWellKnownAttribute g WellKnownValAttributes.DllImportAttribute vref.Deref /// Determine how a top level value is represented, when it is being represented /// as a method. @@ -9415,7 +9415,7 @@ and GenMethodForBinding not v.IsExtensionMember && (match memberInfo.MemberFlags.MemberKind with | SynMemberKind.PropertySet - | SynMemberKind.PropertyGet -> CompileAsEvent cenv.g v.Attribs + | SynMemberKind.PropertyGet -> ValCompileAsEvent cenv.g v | _ -> false) -> @@ -9549,7 +9549,7 @@ and GenMethodForBinding ) // Check if we're compiling the property as a .NET event - assert not (CompileAsEvent cenv.g v.Attribs) + assert not (ValCompileAsEvent cenv.g v) // Emit the property, but not if it's a private method impl if mdef.Access <> ILMemberAccess.Private then @@ -10958,7 +10958,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option if memberInfo.MemberFlags.IsOverrideOrExplicitImpl - && not (CompileAsEvent g vref.Attribs) + && not (ValCompileAsEvent g vref.Deref) then for slotsig in memberInfo.ImplementedSlotSigs do @@ -11433,8 +11433,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option if not isStructRecord && (isCLIMutable - || (EntityHasWellKnownAttribute g WellKnownEntityAttributes.ComVisibleAttribute tycon - && TryFindFSharpBoolAttribute g g.attrib_ComVisibleAttribute tycon.Attribs = Some true)) + || EntityHasWellKnownAttribute g WellKnownEntityAttributes.ComVisibleAttribute_True tycon) then yield mkILSimpleStorageCtor (Some g.ilg.typ_Object.TypeSpec, ilThisTy, [], [], reprAccess, None, eenv.imports) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index f060e7cfa2d..3563799a719 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3675,6 +3675,7 @@ let computeILWellKnownFlags (_g: TcGlobals) (attrs: ILAttributes) : WellKnownILA flags <- flags ||| WellKnownILAttributes.DefaultMemberAttribute | "System.Diagnostics.CodeAnalysis.SetsRequiredMembersAttribute" -> flags <- flags ||| WellKnownILAttributes.SetsRequiredMembersAttribute + | "System.ObsoleteAttribute" -> flags <- flags ||| WellKnownILAttributes.ObsoleteAttribute | _ -> () flags @@ -3745,7 +3746,22 @@ let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEnt match name with | "StructLayoutAttribute" -> flags <- flags ||| WellKnownEntityAttributes.StructLayoutAttribute | "DllImportAttribute" -> flags <- flags ||| WellKnownEntityAttributes.DllImportAttribute - | "ComVisibleAttribute" -> flags <- flags ||| WellKnownEntityAttributes.ComVisibleAttribute + | "ComVisibleAttribute" -> + flags <- + flags + ||| decodeBoolAttribFlag + attrib + WellKnownEntityAttributes.ComVisibleAttribute_True + WellKnownEntityAttributes.ComVisibleAttribute_False + WellKnownEntityAttributes.ComVisibleAttribute_True + | "ComImportAttribute" -> + flags <- + flags + ||| decodeBoolAttribFlag + attrib + WellKnownEntityAttributes.ComImportAttribute_True + WellKnownEntityAttributes.None + WellKnownEntityAttributes.ComImportAttribute_True | _ -> () | [| "System"; "Diagnostics"; name |] -> @@ -3756,6 +3772,7 @@ let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEnt | [| "System"; name |] -> match name with | "AttributeUsageAttribute" -> flags <- flags ||| WellKnownEntityAttributes.AttributeUsageAttribute + | "ObsoleteAttribute" -> flags <- flags ||| WellKnownEntityAttributes.ObsoleteAttribute | _ -> () | _ -> ()) @@ -3800,6 +3817,22 @@ let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEnt | "InterfaceAttribute" -> flags <- flags ||| WellKnownEntityAttributes.InterfaceAttribute | "StructAttribute" -> flags <- flags ||| WellKnownEntityAttributes.StructAttribute | "MeasureAttribute" -> flags <- flags ||| WellKnownEntityAttributes.MeasureAttribute + | "CLIEventAttribute" -> flags <- flags ||| WellKnownEntityAttributes.CLIEventAttribute + | "CompilationRepresentationAttribute" -> + match attrib with + | Attrib(_, _, [ AttribInt32Arg v ], _, _, _, _) -> + if v &&& 0x01 <> 0 then + flags <- flags ||| WellKnownEntityAttributes.CompilationRepresentation_Static + + if v &&& 0x02 <> 0 then + flags <- flags ||| WellKnownEntityAttributes.CompilationRepresentation_Instance + + if v &&& 0x04 <> 0 then + flags <- flags ||| WellKnownEntityAttributes.CompilationRepresentation_ModuleSuffix + + if v &&& 0x08 <> 0 then + flags <- flags ||| WellKnownEntityAttributes.CompilationRepresentation_PermitNull + | _ -> () | _ -> () | _ -> () | ValueNone -> () @@ -3829,21 +3862,12 @@ let mapILFlagToEntityFlag (flag: WellKnownILAttributes) : WellKnownEntityAttribu | WellKnownILAttributes.AllowNullLiteralAttribute -> WellKnownEntityAttributes.AllowNullLiteralAttribute | WellKnownILAttributes.AutoOpenAttribute -> WellKnownEntityAttributes.AutoOpenAttribute | WellKnownILAttributes.ReflectedDefinitionAttribute -> WellKnownEntityAttributes.ReflectedDefinitionAttribute + | WellKnownILAttributes.ObsoleteAttribute -> WellKnownEntityAttributes.ObsoleteAttribute | WellKnownILAttributes.DefaultMemberAttribute -> WellKnownEntityAttributes.None | WellKnownILAttributes.NoEagerConstraintApplicationAttribute -> WellKnownEntityAttributes.None | _ -> WellKnownEntityAttributes.None /// Map a WellKnownILAttributes flag to its WellKnownValAttributes equivalent. -let mapILFlagToValFlag (flag: WellKnownILAttributes) : WellKnownValAttributes = - match flag with - | WellKnownILAttributes.ExtensionAttribute -> WellKnownValAttributes.ExtensionAttribute - | WellKnownILAttributes.ParamArrayAttribute -> WellKnownValAttributes.ParamArrayAttribute - | WellKnownILAttributes.CallerMemberNameAttribute -> WellKnownValAttributes.CallerMemberNameAttribute - | WellKnownILAttributes.CallerFilePathAttribute -> WellKnownValAttributes.CallerFilePathAttribute - | WellKnownILAttributes.CallerLineNumberAttribute -> WellKnownValAttributes.CallerLineNumberAttribute - | WellKnownILAttributes.NoEagerConstraintApplicationAttribute -> WellKnownValAttributes.None - | _ -> WellKnownValAttributes.None - /// Check if an Entity has a specific well-known attribute, computing and caching flags if needed. let EntityHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownEntityAttributes) (entity: Entity) : bool = let ea = entity.EntityAttribs @@ -3929,6 +3953,7 @@ let computeValWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownValAtt flags <- flags ||| WellKnownValAttributes.NoCompilerInliningAttribute | "GeneralizableValueAttribute" -> flags <- flags ||| WellKnownValAttributes.GeneralizableValueAttribute + | "CLIEventAttribute" -> flags <- flags ||| WellKnownValAttributes.CLIEventAttribute | _ -> () | _ -> () | ValueNone -> () @@ -3961,12 +3986,12 @@ let ValHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownValAttributes) (v: V /// Query a three-state bool attribute on an entity. Returns bool option. let EntityTryGetBoolAttribute (g: TcGlobals) (trueFlag: WellKnownEntityAttributes) (falseFlag: WellKnownEntityAttributes) (entity: Entity) : bool option = - let _ = EntityHasWellKnownAttribute g trueFlag entity - let ea = entity.EntityAttribs - - if ea.HasWellKnownAttribute(trueFlag) then Some true - elif ea.HasWellKnownAttribute(falseFlag) then Some false - else Option.None + if not (EntityHasWellKnownAttribute g (trueFlag ||| falseFlag) entity) then + Option.None + else + let ea = entity.EntityAttribs + if ea.HasWellKnownAttribute(trueFlag) then Some true + else Some false /// Analyze three cases for attributes declared on type definitions: IL-declared attributes, F#-declared attributes and /// provided attributes. @@ -9534,14 +9559,9 @@ let XmlDocSigOfEntity (eref: EntityRef) = let enum_CompilationRepresentationAttribute_Static = 0b0000000000000001 let enum_CompilationRepresentationAttribute_Instance = 0b0000000000000010 let enum_CompilationRepresentationAttribute_ModuleSuffix = 0b0000000000000100 -let enum_CompilationRepresentationAttribute_PermitNull = 0b0000000000001000 -let HasUseNullAsTrueValueAttribute g attribs = - match TryFindFSharpInt32Attribute g g.attrib_CompilationRepresentationAttribute attribs with - | Some flags -> ((flags &&& enum_CompilationRepresentationAttribute_PermitNull) <> 0) - | _ -> false - -let TyconHasUseNullAsTrueValueAttribute g (tycon: Tycon) = HasUseNullAsTrueValueAttribute g tycon.Attribs +let TyconHasUseNullAsTrueValueAttribute g (tycon: Tycon) = + EntityHasWellKnownAttribute g WellKnownEntityAttributes.CompilationRepresentation_PermitNull tycon // WARNING: this must match optimizeAlternativeToNull in ilx/cu_erase.fs let CanHaveUseNullAsTrueValueAttribute (_g: TcGlobals) (tycon: Tycon) = @@ -9909,7 +9929,10 @@ let ModuleNameIsMangled g attrs = | Some flags -> ((flags &&& enum_CompilationRepresentationAttribute_ModuleSuffix) <> 0) | _ -> false -let CompileAsEvent g attrs = HasFSharpAttribute g g.attrib_CLIEventAttribute attrs +let CompileAsEvent g attrs = HasFSharpAttribute g g.attrib_CLIEventAttribute attrs + +let ValCompileAsEvent g (v: Val) = + ValHasWellKnownAttribute g WellKnownValAttributes.CLIEventAttribute v let MemberIsCompiledAsInstance g parent isExtensionMember (membInfo: ValMemberInfo) attrs = // All extension members are compiled as static members @@ -9953,9 +9976,7 @@ let isSealedTy g ty = let isComInteropTy g ty = let tcref = tcrefOfAppTy g ty - match g.attrib_ComImportAttribute with - | None -> false - | Some attr -> TryFindFSharpBoolAttribute g attr tcref.Attribs = Some true + EntityHasWellKnownAttribute g WellKnownEntityAttributes.ComImportAttribute_True tcref.Deref let ValSpecIsCompiledAsInstance g (v: Val) = match v.MemberInfo with diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 570674c8b00..2a6d73b43be 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -1872,6 +1872,8 @@ val ModuleNameIsMangled: TcGlobals -> Attribs -> bool val CompileAsEvent: TcGlobals -> Attribs -> bool +val ValCompileAsEvent: TcGlobals -> Val -> bool + val TypeNullIsTrueValue: TcGlobals -> TType -> bool val TypeNullIsExtraValue: TcGlobals -> range -> TType -> bool @@ -2402,9 +2404,6 @@ val EntityHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownEntityAttributes /// Map a WellKnownILAttributes flag to its WellKnownEntityAttributes equivalent. val mapILFlagToEntityFlag: flag: WellKnownILAttributes -> WellKnownEntityAttributes -/// Map a WellKnownILAttributes flag to its WellKnownValAttributes equivalent. -val mapILFlagToValFlag: flag: WellKnownILAttributes -> WellKnownValAttributes - val computeValWellKnownFlags: g: TcGlobals -> attribs: Attribs -> WellKnownValAttributes /// Check if an ArgReprInfo has a specific well-known attribute, computing and caching flags if needed. diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fs b/src/Compiler/TypedTree/WellKnownAttribs.fs index 1c602aadb35..98f99caed28 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fs +++ b/src/Compiler/TypedTree/WellKnownAttribs.fs @@ -27,7 +27,7 @@ type internal WellKnownEntityAttributes = | ReflectedDefinitionAttribute = (1uL <<< 16) | SkipLocalsInitAttribute = (1uL <<< 18) | DebuggerTypeProxyAttribute = (1uL <<< 19) - | ComVisibleAttribute = (1uL <<< 20) + | ComVisibleAttribute_True = (1uL <<< 20) | IsReadOnlyAttribute = (1uL <<< 21) | IsByRefLikeAttribute = (1uL <<< 22) | ExtensionAttribute = (1uL <<< 23) @@ -40,6 +40,14 @@ type internal WellKnownEntityAttributes = | MeasureAttribute = (1uL <<< 30) | DefaultAugmentationAttribute_False = (1uL <<< 31) | AutoSerializableAttribute_False = (1uL <<< 32) + | ComVisibleAttribute_False = (1uL <<< 33) + | ObsoleteAttribute = (1uL <<< 34) + | ComImportAttribute_True = (1uL <<< 35) + | CompilationRepresentation_ModuleSuffix = (1uL <<< 36) + | CompilationRepresentation_PermitNull = (1uL <<< 37) + | CompilationRepresentation_Instance = (1uL <<< 38) + | CompilationRepresentation_Static = (1uL <<< 39) + | CLIEventAttribute = (1uL <<< 40) | NotComputed = (1uL <<< 63) /// Flags enum for well-known attributes on Val (values and members). @@ -77,6 +85,7 @@ type internal WellKnownValAttributes = | DefaultValueAttribute_False = (1uL <<< 27) | NoDynamicInvocationAttribute_False = (1uL <<< 28) | GeneralizableValueAttribute = (1uL <<< 29) + | CLIEventAttribute = (1uL <<< 30) | NotComputed = (1uL <<< 63) /// Generic wrapper for an item list together with cached well-known attribute flags. diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fsi b/src/Compiler/TypedTree/WellKnownAttribs.fsi index bfd96846334..3e78a513baa 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fsi +++ b/src/Compiler/TypedTree/WellKnownAttribs.fsi @@ -26,7 +26,7 @@ type internal WellKnownEntityAttributes = | ReflectedDefinitionAttribute = (1uL <<< 16) | SkipLocalsInitAttribute = (1uL <<< 18) | DebuggerTypeProxyAttribute = (1uL <<< 19) - | ComVisibleAttribute = (1uL <<< 20) + | ComVisibleAttribute_True = (1uL <<< 20) | IsReadOnlyAttribute = (1uL <<< 21) | IsByRefLikeAttribute = (1uL <<< 22) | ExtensionAttribute = (1uL <<< 23) @@ -39,6 +39,14 @@ type internal WellKnownEntityAttributes = | MeasureAttribute = (1uL <<< 30) | DefaultAugmentationAttribute_False = (1uL <<< 31) | AutoSerializableAttribute_False = (1uL <<< 32) + | ComVisibleAttribute_False = (1uL <<< 33) + | ObsoleteAttribute = (1uL <<< 34) + | ComImportAttribute_True = (1uL <<< 35) + | CompilationRepresentation_ModuleSuffix = (1uL <<< 36) + | CompilationRepresentation_PermitNull = (1uL <<< 37) + | CompilationRepresentation_Instance = (1uL <<< 38) + | CompilationRepresentation_Static = (1uL <<< 39) + | CLIEventAttribute = (1uL <<< 40) | NotComputed = (1uL <<< 63) /// Flags enum for well-known attributes on Val (values and members). @@ -75,6 +83,7 @@ type internal WellKnownValAttributes = | DefaultValueAttribute_False = (1uL <<< 27) | NoDynamicInvocationAttribute_False = (1uL <<< 28) | GeneralizableValueAttribute = (1uL <<< 29) + | CLIEventAttribute = (1uL <<< 30) | NotComputed = (1uL <<< 63) /// Generic wrapper for an item list together with cached well-known attribute flags. diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs index 07c8d82416b..77e3974f9f4 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs @@ -1034,9 +1034,9 @@ type Derived() = [] type DU = A | B of int -// Without DefaultAugmentation(false), DU would have IsA/IsB properties -// With it, only tags are available -let x = match DU.A with A -> 1 | B _ -> 2 +let x = DU.A +let _ = x.IsA """ |> typecheck - |> shouldSucceed \ No newline at end of file + |> shouldFail + |> withErrorCode 39 \ No newline at end of file diff --git a/tests/projects/CompilerCompat/CompilerCompatApp/Program.fs b/tests/projects/CompilerCompat/CompilerCompatApp/Program.fs index 3463bb05d20..deb5ec48570 100644 --- a/tests/projects/CompilerCompat/CompilerCompatApp/Program.fs +++ b/tests/projects/CompilerCompat/CompilerCompatApp/Program.fs @@ -42,6 +42,22 @@ let main _argv = let processed = Library.processAnonymousRecord({| X = 123; Y = "test" |}) printfn "Processed result: %s" processed + // Test well-known attribute types + let sealed = CompilerCompatLib.Library.SealedType() + printfn "Sealed: %d" sealed.Value + + let sr = { CompilerCompatLib.Library.StructRecord.X = 1; Y = 2.0 } + printfn "Struct: %d, %f" sr.X sr.Y + + let u = CompilerCompatLib.Library.NoHelpersUnion.Case1 + printfn "Union: %A" u + + let q = CompilerCompatLib.Library.QualifiedEnum.A + printfn "Enum: %A" q + + printfn "Literal: %d" CompilerCompatLib.Library.LiteralValue + printfn "Reflected: %d" (CompilerCompatLib.Library.reflectedFunction 1) + if processed = "Processed: X=123, Y=test" then printfn "SUCCESS: All compiler compatibility tests passed" 0 diff --git a/tests/projects/CompilerCompat/CompilerCompatLib/Library.fs b/tests/projects/CompilerCompat/CompilerCompatLib/Library.fs index e0b4f380802..3eb32f66b68 100644 --- a/tests/projects/CompilerCompat/CompilerCompatLib/Library.fs +++ b/tests/projects/CompilerCompat/CompilerCompatLib/Library.fs @@ -14,4 +14,29 @@ module Library = /// Function that takes an anonymous record as parameter let processAnonymousRecord (record: {| X: int; Y: string |}) = - sprintf "Processed: X=%d, Y=%s" record.X record.Y \ No newline at end of file + sprintf "Processed: X=%d, Y=%s" record.X record.Y + + /// Type with Sealed attribute for compatibility testing + [] + type SealedType() = + member _.Value = 42 + + /// Type with Struct attribute for compatibility testing + [] + type StructRecord = { X: int; Y: float } + + /// Type with DefaultAugmentation(false) for compatibility testing + [] + type NoHelpersUnion = Case1 | Case2 of int + + /// Value with RequireQualifiedAccess for compatibility testing + [] + type QualifiedEnum = A = 0 | B = 1 + + /// Value with Literal attribute + [] + let LiteralValue = 42 + + /// Function with ReflectedDefinition + [] + let reflectedFunction x = x + 1 \ No newline at end of file From aee8ae6166c0a2c64fc9686d40f8ad239cb19aea Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 27 Feb 2026 16:46:41 +0100 Subject: [PATCH 27/71] Remove dead TryFindFSharpBoolAttributeAssumeFalse helper All callers migrated to decodeBoolAttribFlag in compute functions. Inline TryFindFSharpBoolAttribute (default=true) directly. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TypedTreeOps.fs | 7 ++----- src/Compiler/TypedTree/TypedTreeOps.fsi | 2 -- .../FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl | 1 + 3 files changed, 3 insertions(+), 7 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 3563799a719..643bf70ead4 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3578,15 +3578,12 @@ let (|AttribStringArg|_|) = function AttribExpr(_, Expr.Const (Const.String n, _ let (|AttribElemStringArg|_|) = function ILAttribElem.String(n) -> n | _ -> None -let TryFindFSharpBoolAttributeWithDefault dflt g nm attrs = +let TryFindFSharpBoolAttribute g nm attrs = match TryFindFSharpAttribute g nm attrs with - | Some(Attrib(_, _, [ ], _, _, _, _)) -> Some dflt + | Some(Attrib(_, _, [], _, _, _, _)) -> Some true | Some(Attrib(_, _, [ AttribBoolArg b ], _, _, _, _)) -> Some b | _ -> None -let TryFindFSharpBoolAttribute g nm attrs = TryFindFSharpBoolAttributeWithDefault true g nm attrs -let TryFindFSharpBoolAttributeAssumeFalse g nm attrs = TryFindFSharpBoolAttributeWithDefault false g nm attrs - let TryFindFSharpInt32Attribute g nm attrs = match TryFindFSharpAttribute g nm attrs with | Some(Attrib(_, _, [ AttribInt32Arg b ], _, _, _, _)) -> Some b diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 2a6d73b43be..c3471fbf0b4 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2434,8 +2434,6 @@ val TryFindFSharpAttributeOpt: TcGlobals -> BuiltinAttribInfo option -> Attribs val TryFindFSharpBoolAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> bool option -val TryFindFSharpBoolAttributeAssumeFalse: TcGlobals -> BuiltinAttribInfo -> Attribs -> bool option - val TryFindFSharpStringAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> string option val TryFindLocalizedFSharpStringAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> string option diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl index 2b870b4c448..26abda52752 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl @@ -1836,6 +1836,7 @@ FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes NoEag FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes None FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes NotComputed FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes NullableAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes ObsoleteAttribute FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes ParamArrayAttribute FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes ReflectedDefinitionAttribute FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes RequiresLocationAttribute From c1c2173d83da1edbdcef6a7ef61af48bbdf5cde3 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 27 Feb 2026 18:49:54 +0100 Subject: [PATCH 28/71] Phase A: Use already-computed entity flags in Phase1G Replace redundant HasFSharpAttribute/TryFindFSharpBoolAttribute calls with direct flag tests on the entityFlags that are already computed 3 lines above. - SealedAttribute: split into _True/_False flag pair for three-state semantics - MeasureableAttribute: add to WellKnownEntityAttributes enum - hasMeasureAttr, hasMeasureableAttr, hasAllowNullLiteralAttr: test entityFlags bits - structLayoutAttr: kept as TryFindFSharpInt32Attribute (needs LayoutKind int) Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/CheckDeclarations.fs | 20 ++++++++++++-------- src/Compiler/TypedTree/TypedTreeOps.fs | 13 +++++++++---- src/Compiler/TypedTree/WellKnownAttribs.fs | 4 +++- src/Compiler/TypedTree/WellKnownAttribs.fsi | 4 +++- 4 files changed, 27 insertions(+), 14 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index bb6f69b599a..ff6f06934a5 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -2085,7 +2085,7 @@ let TcMutRecDefns_Phase2 (cenv: cenv) envInitial mBinds scopem mutRecNSInfo (env let (MutRecDefnsPhase2DataForTycon(tyconOpt, _x, declKind, tcref, _, _, declaredTyconTypars, synMembers, _, _, fixupFinalAttrs)) = tyconData // If a tye uses both [] and [] attributes it means it is a static class. - let isStaticClass = EntityHasWellKnownAttribute g WellKnownEntityAttributes.SealedAttribute tcref.Deref && EntityHasWellKnownAttribute g WellKnownEntityAttributes.AbstractClassAttribute tcref.Deref + let isStaticClass = EntityHasWellKnownAttribute g WellKnownEntityAttributes.SealedAttribute_True tcref.Deref && EntityHasWellKnownAttribute g WellKnownEntityAttributes.AbstractClassAttribute tcref.Deref if isStaticClass && g.langVersion.SupportsFeature(LanguageFeature.ErrorReportingOnStaticClasses) then ReportErrorOnStaticClass synMembers match tyconOpt with @@ -2857,7 +2857,7 @@ module EstablishTypeDefinitionCores = let hasStructAttr = entityFlags &&& WellKnownEntityAttributes.StructAttribute <> WellKnownEntityAttributes.None let hasCLIMutable = entityFlags &&& WellKnownEntityAttributes.CLIMutableAttribute <> WellKnownEntityAttributes.None let hasAllowNullLiteralAttr = entityFlags &&& WellKnownEntityAttributes.AllowNullLiteralAttribute <> WellKnownEntityAttributes.None - let hasSealedAttr = entityFlags &&& WellKnownEntityAttributes.SealedAttribute <> WellKnownEntityAttributes.None + let hasSealedAttr = entityFlags &&& WellKnownEntityAttributes.SealedAttribute_True <> WellKnownEntityAttributes.None let structLayoutAttr = entityFlags &&& WellKnownEntityAttributes.StructLayoutAttribute <> WellKnownEntityAttributes.None // We want to keep these special attributes treatment and avoid having two errors for the same attribute. @@ -3397,20 +3397,24 @@ module EstablishTypeDefinitionCores = let entityFlags = computeEntityWellKnownFlags g attrs let hasAbstractAttr = entityFlags &&& WellKnownEntityAttributes.AbstractClassAttribute <> WellKnownEntityAttributes.None - let hasSealedAttr = + let hasSealedAttr = // The special case is needed for 'unit' because the 'Sealed' attribute is not yet available when this type is defined. - if g.compilingFSharpCore && id.idText = "Unit" then + if g.compilingFSharpCore && id.idText = "Unit" then Some true + elif entityFlags &&& WellKnownEntityAttributes.SealedAttribute_True <> WellKnownEntityAttributes.None then + Some true + elif entityFlags &&& WellKnownEntityAttributes.SealedAttribute_False <> WellKnownEntityAttributes.None then + Some false else - TryFindFSharpBoolAttribute g g.attrib_SealedAttribute attrs - let hasMeasureAttr = HasFSharpAttribute g g.attrib_MeasureAttribute attrs + None + let hasMeasureAttr = entityFlags &&& WellKnownEntityAttributes.MeasureAttribute <> WellKnownEntityAttributes.None // REVIEW: for hasMeasureableAttr we need to be stricter about checking these // are only used on exactly the right kinds of type definitions and not in conjunction with other attributes. - let hasMeasureableAttr = HasFSharpAttribute g g.attrib_MeasureableAttribute attrs + let hasMeasureableAttr = entityFlags &&& WellKnownEntityAttributes.MeasureableAttribute <> WellKnownEntityAttributes.None let structLayoutAttr = TryFindFSharpInt32Attribute g g.attrib_StructLayoutAttribute attrs - let hasAllowNullLiteralAttr = TryFindFSharpBoolAttribute g g.attrib_AllowNullLiteralAttribute attrs = Some true + let hasAllowNullLiteralAttr = entityFlags &&& WellKnownEntityAttributes.AllowNullLiteralAttribute <> WellKnownEntityAttributes.None if hasAbstractAttr then tycon.TypeContents.tcaug_abstract <- true diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 643bf70ead4..26ab9de2b48 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3781,9 +3781,13 @@ let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEnt | [| "Microsoft"; "FSharp"; "Core"; name |] -> match name with | "SealedAttribute" -> - match attrib with - | Attrib(_, _, [ AttribBoolArg false ], _, _, _, _) -> () - | _ -> flags <- flags ||| WellKnownEntityAttributes.SealedAttribute + flags <- + flags + ||| decodeBoolAttribFlag + attrib + WellKnownEntityAttributes.SealedAttribute_True + WellKnownEntityAttributes.SealedAttribute_False + WellKnownEntityAttributes.SealedAttribute_True | "AbstractClassAttribute" -> flags <- flags ||| WellKnownEntityAttributes.AbstractClassAttribute | "RequireQualifiedAccessAttribute" -> flags <- flags ||| WellKnownEntityAttributes.RequireQualifiedAccessAttribute @@ -3814,6 +3818,7 @@ let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEnt | "InterfaceAttribute" -> flags <- flags ||| WellKnownEntityAttributes.InterfaceAttribute | "StructAttribute" -> flags <- flags ||| WellKnownEntityAttributes.StructAttribute | "MeasureAttribute" -> flags <- flags ||| WellKnownEntityAttributes.MeasureAttribute + | "MeasureableAttribute" -> flags <- flags ||| WellKnownEntityAttributes.MeasureableAttribute | "CLIEventAttribute" -> flags <- flags ||| WellKnownEntityAttributes.CLIEventAttribute | "CompilationRepresentationAttribute" -> match attrib with @@ -9966,7 +9971,7 @@ let isSealedTy g ty = | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> if (isFSharpInterfaceTy g ty || isFSharpClassTy g ty) then let tcref = tcrefOfAppTy g ty - EntityHasWellKnownAttribute g WellKnownEntityAttributes.SealedAttribute tcref.Deref + EntityHasWellKnownAttribute g WellKnownEntityAttributes.SealedAttribute_True tcref.Deref else // All other F# types, array, byref, tuple types are sealed true diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fs b/src/Compiler/TypedTree/WellKnownAttribs.fs index 98f99caed28..117b2ebb1d8 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fs +++ b/src/Compiler/TypedTree/WellKnownAttribs.fs @@ -11,7 +11,7 @@ type internal WellKnownEntityAttributes = | RequireQualifiedAccessAttribute = (1uL <<< 0) | AutoOpenAttribute = (1uL <<< 1) | AbstractClassAttribute = (1uL <<< 2) - | SealedAttribute = (1uL <<< 3) + | SealedAttribute_True = (1uL <<< 3) | NoEqualityAttribute = (1uL <<< 4) | NoComparisonAttribute = (1uL <<< 5) | StructuralEqualityAttribute = (1uL <<< 6) @@ -25,6 +25,7 @@ type internal WellKnownEntityAttributes = | StructLayoutAttribute = (1uL <<< 14) | DllImportAttribute = (1uL <<< 15) | ReflectedDefinitionAttribute = (1uL <<< 16) + | MeasureableAttribute = (1uL <<< 17) | SkipLocalsInitAttribute = (1uL <<< 18) | DebuggerTypeProxyAttribute = (1uL <<< 19) | ComVisibleAttribute_True = (1uL <<< 20) @@ -48,6 +49,7 @@ type internal WellKnownEntityAttributes = | CompilationRepresentation_Instance = (1uL <<< 38) | CompilationRepresentation_Static = (1uL <<< 39) | CLIEventAttribute = (1uL <<< 40) + | SealedAttribute_False = (1uL <<< 41) | NotComputed = (1uL <<< 63) /// Flags enum for well-known attributes on Val (values and members). diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fsi b/src/Compiler/TypedTree/WellKnownAttribs.fsi index 3e78a513baa..6a30cdac540 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fsi +++ b/src/Compiler/TypedTree/WellKnownAttribs.fsi @@ -10,7 +10,7 @@ type internal WellKnownEntityAttributes = | RequireQualifiedAccessAttribute = (1uL <<< 0) | AutoOpenAttribute = (1uL <<< 1) | AbstractClassAttribute = (1uL <<< 2) - | SealedAttribute = (1uL <<< 3) + | SealedAttribute_True = (1uL <<< 3) | NoEqualityAttribute = (1uL <<< 4) | NoComparisonAttribute = (1uL <<< 5) | StructuralEqualityAttribute = (1uL <<< 6) @@ -24,6 +24,7 @@ type internal WellKnownEntityAttributes = | StructLayoutAttribute = (1uL <<< 14) | DllImportAttribute = (1uL <<< 15) | ReflectedDefinitionAttribute = (1uL <<< 16) + | MeasureableAttribute = (1uL <<< 17) | SkipLocalsInitAttribute = (1uL <<< 18) | DebuggerTypeProxyAttribute = (1uL <<< 19) | ComVisibleAttribute_True = (1uL <<< 20) @@ -47,6 +48,7 @@ type internal WellKnownEntityAttributes = | CompilationRepresentation_Instance = (1uL <<< 38) | CompilationRepresentation_Static = (1uL <<< 39) | CLIEventAttribute = (1uL <<< 40) + | SealedAttribute_False = (1uL <<< 41) | NotComputed = (1uL <<< 63) /// Flags enum for well-known attributes on Val (values and members). From 6a4701da2e2cf7000e6b4ae63b84b7f567c81679 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 27 Feb 2026 18:52:04 +0100 Subject: [PATCH 29/71] Phase B: Compute entity flags ad-hoc in Phase1B and early typar check Replace HasFSharpAttribute with computeEntityWellKnownFlags + bit test in TcTyconDefnCore_Phase1B and TyparsAllHaveMeasureDeclEarlyCheck. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/CheckDeclarations.fs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index ff6f06934a5..d6813daf981 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -2695,7 +2695,8 @@ module EstablishTypeDefinitionCores = try let (SynTyparDecl (attributes = Attributes synAttrs)) = synTypar let attrs = TcAttributes cenv env AttributeTargets.GenericParameter synAttrs - HasFSharpAttribute cenv.g cenv.g.attrib_MeasureAttribute attrs + let flags = computeEntityWellKnownFlags cenv.g attrs + flags &&& WellKnownEntityAttributes.MeasureAttribute <> WellKnownEntityAttributes.None with _ -> false)) let TypeNamesInMutRecDecls cenv env (compDecls: MutRecShapes) = @@ -3192,8 +3193,9 @@ module EstablishTypeDefinitionCores = let id = tycon.Id let thisTyconRef = mkLocalTyconRef tycon - let hasMeasureAttr = HasFSharpAttribute g g.attrib_MeasureAttribute attrs - let hasMeasureableAttr = HasFSharpAttribute g g.attrib_MeasureableAttribute attrs + let entityFlags = computeEntityWellKnownFlags g attrs + let hasMeasureAttr = entityFlags &&& WellKnownEntityAttributes.MeasureAttribute <> WellKnownEntityAttributes.None + let hasMeasureableAttr = entityFlags &&& WellKnownEntityAttributes.MeasureableAttribute <> WellKnownEntityAttributes.None let envinner = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars m) envinner let envinner = MakeInnerEnvForTyconRef envinner thisTyconRef false From 59b08f788d8ffc3cdb44bc27c647e53b9dc89810 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 27 Feb 2026 18:56:00 +0100 Subject: [PATCH 30/71] Phase C: Compute val flags ad-hoc in CheckExpressions Replace HasFSharpAttribute/HasFSharpAttributeOpt with computeValWellKnownFlags + bit tests for: LiteralAttribute (3 sites), DllImportAttribute (1 site), NoCompilerInliningAttribute (1 site). ComputeInlineFlag computes flags once for both NoCompilerInlining and DllImport checks. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../Checking/Expressions/CheckExpressions.fs | 22 ++++++++++++++----- 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 7a0d8bf85f4..1df523dc52d 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -1401,8 +1401,10 @@ let MakeAndPublishVal (cenv: cenv) env (altActualParent, inSig, declKind, valRec let vis, _ = ComputeAccessAndCompPath g env (Some declKind) id.idRange vis overrideVis actualParent + let valFlags = computeValWellKnownFlags g attrs + let inlineFlag = - if HasFSharpAttributeOpt g g.attrib_DllImportAttribute attrs then + if valFlags &&& WellKnownValAttributes.DllImportAttribute <> WellKnownValAttributes.None then if inlineFlag = ValInline.Always then errorR(Error(FSComp.SR.tcDllImportStubsCannotBeInlined(), m)) ValInline.Never @@ -2380,14 +2382,18 @@ module GeneralizationHelpers = //------------------------------------------------------------------------- let ComputeInlineFlag (memFlagsOption: SynMemberFlags option) isInline isMutable g attrs m = - let hasNoCompilerInliningAttribute () = HasFSharpAttribute g g.attrib_NoCompilerInliningAttribute attrs + let valFlags = computeValWellKnownFlags g attrs + + let hasNoCompilerInliningAttribute () = + valFlags &&& WellKnownValAttributes.NoCompilerInliningAttribute <> WellKnownValAttributes.None let isCtorOrAbstractSlot () = match memFlagsOption with | None -> false | Some x -> (x.MemberKind = SynMemberKind.Constructor) || x.IsDispatchSlot || x.IsOverrideOrExplicitImpl - let isExtern () = HasFSharpAttributeOpt g g.attrib_DllImportAttribute attrs + let isExtern () = + valFlags &&& WellKnownValAttributes.DllImportAttribute <> WellKnownValAttributes.None let inlineFlag, reportIncorrectInlineKeywordUsage = // Mutable values may never be inlined @@ -11355,7 +11361,10 @@ and TcLiteral (cenv: cenv) overallTy env tpenv (attrs, synLiteralValExpr) = let g = cenv.g - let hasLiteralAttr = HasFSharpAttribute g g.attrib_LiteralAttribute attrs + let valFlags = computeValWellKnownFlags g attrs + + let hasLiteralAttr = + valFlags &&& WellKnownValAttributes.LiteralAttribute <> WellKnownValAttributes.None if hasLiteralAttr then let literalValExpr, _ = TcExpr cenv (MustEqual overallTy) env tpenv synLiteralValExpr @@ -11737,7 +11746,7 @@ and TcLetBinding (cenv: cenv) isUse env containerInfo declKind tpenv (synBinds, | _ when inlineFlag.ShouldInline -> error(Error(FSComp.SR.tcInvalidInlineSpecification(), m)) - | TPat_query _ when HasFSharpAttribute g g.attrib_LiteralAttribute attrs -> + | TPat_query _ when computeValWellKnownFlags g attrs &&& WellKnownValAttributes.LiteralAttribute <> WellKnownValAttributes.None -> error(Error(FSComp.SR.tcLiteralAttributeCannotUseActivePattern(), m)) | _ -> @@ -13070,7 +13079,8 @@ let TcAndPublishValSpec (cenv: cenv, env, containerInfo: ContainerInfo, declKind let literalValue = match literalExprOpt with | None -> - let hasLiteralAttr = HasFSharpAttribute g g.attrib_LiteralAttribute attrs + let hasLiteralAttr = + computeValWellKnownFlags g attrs &&& WellKnownValAttributes.LiteralAttribute <> WellKnownValAttributes.None if hasLiteralAttr then errorR(Error(FSComp.SR.tcLiteralAttributeRequiresConstantValue(), m)) None From 01fd4a6643db24043f6c8db8fea260ae1e31b88b Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 27 Feb 2026 18:57:27 +0100 Subject: [PATCH 31/71] Phase D: Compute val flags in GenParamAttribs Replace HasFSharpAttribute/HasFSharpAttributeOpt with computeValWellKnownFlags + bit tests for InAttribute, OutAttribute, OptionalAttribute in GenParamAttribs. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/CodeGen/IlxGen.fs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index ec4a69a6b5c..972d62e6519 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -8944,14 +8944,18 @@ and GenMarshal cenv attribs = /// Generate special attributes on an IL parameter and GenParamAttribs cenv paramTy attribs = let g = cenv.g + let valFlags = computeValWellKnownFlags g attribs let inFlag = - HasFSharpAttribute g g.attrib_InAttribute attribs || isInByrefTy g paramTy + valFlags &&& WellKnownValAttributes.InAttribute <> WellKnownValAttributes.None + || isInByrefTy g paramTy let outFlag = - HasFSharpAttribute g g.attrib_OutAttribute attribs || isOutByrefTy g paramTy + valFlags &&& WellKnownValAttributes.OutAttribute <> WellKnownValAttributes.None + || isOutByrefTy g paramTy - let optionalFlag = HasFSharpAttributeOpt g g.attrib_OptionalAttribute attribs + let optionalFlag = + valFlags &&& WellKnownValAttributes.OptionalAttribute <> WellKnownValAttributes.None let defaultValue = TryFindFSharpAttributeOpt g g.attrib_DefaultParameterValueAttribute attribs From f26158fa9f470de19b7dfdb49465aa9433d38838 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 27 Feb 2026 19:00:56 +0100 Subject: [PATCH 32/71] Phase E: Compute val flags ad-hoc for field-level attrs - CheckDeclarations field attrs: compute computeValWellKnownFlags once for DefaultValueAttribute, VolatileFieldAttribute, ThreadStatic, ContextStatic - PostInferenceChecks: DefaultValueAttribute_True flag for zero-init check - TypedTreeOps: DefaultValueAttribute_False flag for field filtering - IlxGen NonSerializedAttribute: kept as-is (single site, merged list) Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/CheckDeclarations.fs | 9 ++++++--- src/Compiler/Checking/PostInferenceChecks.fs | 16 ++++++++++++---- src/Compiler/TypedTree/TypedTreeOps.fs | 4 +++- 3 files changed, 21 insertions(+), 8 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index d6813daf981..82e97f67f08 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -434,10 +434,13 @@ module TcRecdUnionAndEnumDeclarations = let attrsForProperty = (List.map snd attrsForProperty) let attrsForField = (List.map snd attrsForField) let tyR, _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurrence.UseInType WarnOnIWSAM.Yes env tpenv ty - let zeroInit = HasFSharpAttribute g g.attrib_DefaultValueAttribute attrsForField - let isVolatile = HasFSharpAttribute g g.attrib_VolatileFieldAttribute attrsForField + let fieldFlags = computeValWellKnownFlags g attrsForField + let zeroInit = fieldFlags &&& WellKnownValAttributes.DefaultValueAttribute_True <> WellKnownValAttributes.None + let isVolatile = fieldFlags &&& WellKnownValAttributes.VolatileFieldAttribute <> WellKnownValAttributes.None - let isThreadStatic = isThreadOrContextStatic g attrsForField + let isThreadStatic = + fieldFlags &&& WellKnownValAttributes.ThreadStaticAttribute <> WellKnownValAttributes.None + || fieldFlags &&& WellKnownValAttributes.ContextStaticAttribute <> WellKnownValAttributes.None if isThreadStatic && (not zeroInit || not isStatic) then errorR(Error(FSComp.SR.tcThreadStaticAndContextStaticMustBeStatic(), m)) diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 3f2fa5db139..ce20c49457e 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -2648,8 +2648,12 @@ let CheckEntityDefn cenv env (tycon: Entity) = for f in tycon.AllInstanceFieldsAsList do let m = f.Range // Check if it's marked unsafe - let zeroInitUnsafe = TryFindFSharpBoolAttribute g g.attrib_DefaultValueAttribute f.FieldAttribs - if zeroInitUnsafe = Some true then + let zeroInitUnsafe = + computeValWellKnownFlags g f.FieldAttribs + &&& WellKnownValAttributes.DefaultValueAttribute_True + <> WellKnownValAttributes.None + + if zeroInitUnsafe then let ty = f.FormalType // If the condition is detected because of a variation in logic introduced because // of nullness checking, then only a warning is emitted. @@ -2664,8 +2668,12 @@ let CheckEntityDefn cenv env (tycon: Entity) = for f in tycon.AllInstanceFieldsAsList do let m = f.Range // Check if it's marked unsafe - let zeroInitUnsafe = TryFindFSharpBoolAttribute g g.attrib_DefaultValueAttribute f.FieldAttribs - if zeroInitUnsafe = Some true then + let zeroInitUnsafe = + computeValWellKnownFlags g f.FieldAttribs + &&& WellKnownValAttributes.DefaultValueAttribute_True + <> WellKnownValAttributes.None + + if zeroInitUnsafe then if not (TypeHasDefaultValue g m f.FormalType) then errorR(Error(FSComp.SR.chkValueWithDefaultValueMustHaveDefaultValue(), m)) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 26ab9de2b48..2f53d054496 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -9773,7 +9773,9 @@ let rec TypeHasDefaultValueAux isNew g m ty = // Note this includes fields implied by the use of the implicit class construction syntax tcref.AllInstanceFieldsAsList // We can ignore fields with the DefaultValue(false) attribute - |> List.filter (fun fld -> TryFindFSharpBoolAttribute g g.attrib_DefaultValueAttribute fld.FieldAttribs <> Some false) + |> List.filter (fun fld -> + let flags = computeValWellKnownFlags g fld.FieldAttribs + flags &&& WellKnownValAttributes.DefaultValueAttribute_False = WellKnownValAttributes.None) flds |> List.forall (actualTyOfRecdField (mkTyconRefInst tcref tinst) >> TypeHasDefaultValueAux isNew g m) From edfa4316f22a09224c0e5a5e3327b9d73d5aaa52 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 27 Feb 2026 19:04:34 +0100 Subject: [PATCH 33/71] Fix review findings: MeasureableAttribute name, AllowNullLiteral True/False - Fix MeasureableAttribute: match on 'MeasureAnnotatedAbbreviationAttribute' (the actual FSharp.Core type name) instead of 'MeasureableAttribute' - AllowNullLiteralAttribute: split into _True/_False pair to preserve three-state semantics ([] vs absence) - Fix all references to renamed enum cases Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/CheckDeclarations.fs | 4 ++-- src/Compiler/TypedTree/TypedTreeOps.fs | 13 ++++++++++--- src/Compiler/TypedTree/WellKnownAttribs.fs | 3 ++- src/Compiler/TypedTree/WellKnownAttribs.fsi | 3 ++- 4 files changed, 16 insertions(+), 7 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 82e97f67f08..2fcebeff398 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -2860,7 +2860,7 @@ module EstablishTypeDefinitionCores = let hasMeasureAttr = entityFlags &&& WellKnownEntityAttributes.MeasureAttribute <> WellKnownEntityAttributes.None let hasStructAttr = entityFlags &&& WellKnownEntityAttributes.StructAttribute <> WellKnownEntityAttributes.None let hasCLIMutable = entityFlags &&& WellKnownEntityAttributes.CLIMutableAttribute <> WellKnownEntityAttributes.None - let hasAllowNullLiteralAttr = entityFlags &&& WellKnownEntityAttributes.AllowNullLiteralAttribute <> WellKnownEntityAttributes.None + let hasAllowNullLiteralAttr = entityFlags &&& WellKnownEntityAttributes.AllowNullLiteralAttribute_True <> WellKnownEntityAttributes.None let hasSealedAttr = entityFlags &&& WellKnownEntityAttributes.SealedAttribute_True <> WellKnownEntityAttributes.None let structLayoutAttr = entityFlags &&& WellKnownEntityAttributes.StructLayoutAttribute <> WellKnownEntityAttributes.None @@ -3419,7 +3419,7 @@ module EstablishTypeDefinitionCores = let hasMeasureableAttr = entityFlags &&& WellKnownEntityAttributes.MeasureableAttribute <> WellKnownEntityAttributes.None let structLayoutAttr = TryFindFSharpInt32Attribute g g.attrib_StructLayoutAttribute attrs - let hasAllowNullLiteralAttr = entityFlags &&& WellKnownEntityAttributes.AllowNullLiteralAttribute <> WellKnownEntityAttributes.None + let hasAllowNullLiteralAttr = entityFlags &&& WellKnownEntityAttributes.AllowNullLiteralAttribute_True <> WellKnownEntityAttributes.None if hasAbstractAttr then tycon.TypeContents.tcaug_abstract <- true diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 2f53d054496..34c29702c42 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3811,14 +3811,21 @@ let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEnt | "ReflectedDefinitionAttribute" -> flags <- flags ||| WellKnownEntityAttributes.ReflectedDefinitionAttribute | "AllowNullLiteralAttribute" -> - flags <- flags ||| WellKnownEntityAttributes.AllowNullLiteralAttribute + flags <- + flags + ||| decodeBoolAttribFlag + attrib + WellKnownEntityAttributes.AllowNullLiteralAttribute_True + WellKnownEntityAttributes.AllowNullLiteralAttribute_False + WellKnownEntityAttributes.AllowNullLiteralAttribute_True | "WarnOnWithoutNullArgumentAttribute" -> flags <- flags ||| WellKnownEntityAttributes.WarnOnWithoutNullArgumentAttribute | "ClassAttribute" -> flags <- flags ||| WellKnownEntityAttributes.ClassAttribute | "InterfaceAttribute" -> flags <- flags ||| WellKnownEntityAttributes.InterfaceAttribute | "StructAttribute" -> flags <- flags ||| WellKnownEntityAttributes.StructAttribute | "MeasureAttribute" -> flags <- flags ||| WellKnownEntityAttributes.MeasureAttribute - | "MeasureableAttribute" -> flags <- flags ||| WellKnownEntityAttributes.MeasureableAttribute + | "MeasureAnnotatedAbbreviationAttribute" -> + flags <- flags ||| WellKnownEntityAttributes.MeasureableAttribute | "CLIEventAttribute" -> flags <- flags ||| WellKnownEntityAttributes.CLIEventAttribute | "CompilationRepresentationAttribute" -> match attrib with @@ -3861,7 +3868,7 @@ let mapILFlagToEntityFlag (flag: WellKnownILAttributes) : WellKnownEntityAttribu | WellKnownILAttributes.IsReadOnlyAttribute -> WellKnownEntityAttributes.IsReadOnlyAttribute | WellKnownILAttributes.IsByRefLikeAttribute -> WellKnownEntityAttributes.IsByRefLikeAttribute | WellKnownILAttributes.ExtensionAttribute -> WellKnownEntityAttributes.ExtensionAttribute - | WellKnownILAttributes.AllowNullLiteralAttribute -> WellKnownEntityAttributes.AllowNullLiteralAttribute + | WellKnownILAttributes.AllowNullLiteralAttribute -> WellKnownEntityAttributes.AllowNullLiteralAttribute_True | WellKnownILAttributes.AutoOpenAttribute -> WellKnownEntityAttributes.AutoOpenAttribute | WellKnownILAttributes.ReflectedDefinitionAttribute -> WellKnownEntityAttributes.ReflectedDefinitionAttribute | WellKnownILAttributes.ObsoleteAttribute -> WellKnownEntityAttributes.ObsoleteAttribute diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fs b/src/Compiler/TypedTree/WellKnownAttribs.fs index 117b2ebb1d8..ca894000ce4 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fs +++ b/src/Compiler/TypedTree/WellKnownAttribs.fs @@ -34,7 +34,7 @@ type internal WellKnownEntityAttributes = | ExtensionAttribute = (1uL <<< 23) | AttributeUsageAttribute = (1uL <<< 24) | WarnOnWithoutNullArgumentAttribute = (1uL <<< 25) - | AllowNullLiteralAttribute = (1uL <<< 26) + | AllowNullLiteralAttribute_True = (1uL <<< 26) | ClassAttribute = (1uL <<< 27) | InterfaceAttribute = (1uL <<< 28) | StructAttribute = (1uL <<< 29) @@ -50,6 +50,7 @@ type internal WellKnownEntityAttributes = | CompilationRepresentation_Static = (1uL <<< 39) | CLIEventAttribute = (1uL <<< 40) | SealedAttribute_False = (1uL <<< 41) + | AllowNullLiteralAttribute_False = (1uL <<< 42) | NotComputed = (1uL <<< 63) /// Flags enum for well-known attributes on Val (values and members). diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fsi b/src/Compiler/TypedTree/WellKnownAttribs.fsi index 6a30cdac540..8b4eb796e3f 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fsi +++ b/src/Compiler/TypedTree/WellKnownAttribs.fsi @@ -33,7 +33,7 @@ type internal WellKnownEntityAttributes = | ExtensionAttribute = (1uL <<< 23) | AttributeUsageAttribute = (1uL <<< 24) | WarnOnWithoutNullArgumentAttribute = (1uL <<< 25) - | AllowNullLiteralAttribute = (1uL <<< 26) + | AllowNullLiteralAttribute_True = (1uL <<< 26) | ClassAttribute = (1uL <<< 27) | InterfaceAttribute = (1uL <<< 28) | StructAttribute = (1uL <<< 29) @@ -49,6 +49,7 @@ type internal WellKnownEntityAttributes = | CompilationRepresentation_Static = (1uL <<< 39) | CLIEventAttribute = (1uL <<< 40) | SealedAttribute_False = (1uL <<< 41) + | AllowNullLiteralAttribute_False = (1uL <<< 42) | NotComputed = (1uL <<< 63) /// Flags enum for well-known attributes on Val (values and members). From 1ad2390e4948a1c1e72139ade4a0993a3bcfca02 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 27 Feb 2026 19:12:42 +0100 Subject: [PATCH 34/71] Add attribsHaveEntityFlag/attribsHaveValFlag helpers, refactor callsites Address review findings: extract inline helpers for ad-hoc flag testing on raw Attrib lists. Refactor all verbose computeXWellKnownFlags + bit test patterns to use the new helpers. Fix ThreadStatic/ContextStatic to use combined ||| pattern. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/AttributeChecking.fs | 2 +- src/Compiler/Checking/CheckDeclarations.fs | 14 +++++++------- .../Checking/Expressions/CheckExpressions.fs | 6 +++--- src/Compiler/Checking/PostInferenceChecks.fs | 8 ++------ src/Compiler/TypedTree/TypedTreeOps.fs | 11 +++++++++-- src/Compiler/TypedTree/TypedTreeOps.fsi | 4 ++++ 6 files changed, 26 insertions(+), 19 deletions(-) diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index 6a7b46d1de0..a96d8a0dd4a 100755 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -559,7 +559,7 @@ let CheckMethInfoAttributes g m tyargsOpt (minfo: MethInfo) = let res = trackErrors { do! CheckFSharpAttributes g fsAttribs m - if Option.isNone tyargsOpt && (computeValWellKnownFlags g fsAttribs &&& WellKnownValAttributes.RequiresExplicitTypeArgumentsAttribute <> WellKnownValAttributes.None) then + if Option.isNone tyargsOpt && (attribsHaveValFlag g WellKnownValAttributes.RequiresExplicitTypeArgumentsAttribute fsAttribs) then do! ErrorD(Error(FSComp.SR.tcFunctionRequiresExplicitTypeArguments(minfo.LogicalName), m)) } diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 2fcebeff398..7af64aac221 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -439,8 +439,10 @@ module TcRecdUnionAndEnumDeclarations = let isVolatile = fieldFlags &&& WellKnownValAttributes.VolatileFieldAttribute <> WellKnownValAttributes.None let isThreadStatic = - fieldFlags &&& WellKnownValAttributes.ThreadStaticAttribute <> WellKnownValAttributes.None - || fieldFlags &&& WellKnownValAttributes.ContextStaticAttribute <> WellKnownValAttributes.None + fieldFlags + &&& (WellKnownValAttributes.ThreadStaticAttribute + ||| WellKnownValAttributes.ContextStaticAttribute) + <> WellKnownValAttributes.None if isThreadStatic && (not zeroInit || not isStatic) then errorR(Error(FSComp.SR.tcThreadStaticAndContextStaticMustBeStatic(), m)) @@ -2698,8 +2700,7 @@ module EstablishTypeDefinitionCores = try let (SynTyparDecl (attributes = Attributes synAttrs)) = synTypar let attrs = TcAttributes cenv env AttributeTargets.GenericParameter synAttrs - let flags = computeEntityWellKnownFlags cenv.g attrs - flags &&& WellKnownEntityAttributes.MeasureAttribute <> WellKnownEntityAttributes.None + attribsHaveEntityFlag cenv.g WellKnownEntityAttributes.MeasureAttribute attrs with _ -> false)) let TypeNamesInMutRecDecls cenv env (compDecls: MutRecShapes) = @@ -3196,9 +3197,8 @@ module EstablishTypeDefinitionCores = let id = tycon.Id let thisTyconRef = mkLocalTyconRef tycon - let entityFlags = computeEntityWellKnownFlags g attrs - let hasMeasureAttr = entityFlags &&& WellKnownEntityAttributes.MeasureAttribute <> WellKnownEntityAttributes.None - let hasMeasureableAttr = entityFlags &&& WellKnownEntityAttributes.MeasureableAttribute <> WellKnownEntityAttributes.None + let hasMeasureAttr = attribsHaveEntityFlag g WellKnownEntityAttributes.MeasureAttribute attrs + let hasMeasureableAttr = attribsHaveEntityFlag g WellKnownEntityAttributes.MeasureableAttribute attrs let envinner = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars m) envinner let envinner = MakeInnerEnvForTyconRef envinner thisTyconRef false diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 1df523dc52d..796fb4ee992 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -11136,7 +11136,7 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt spatsL |> List.map (SynInfo.InferSynArgInfoFromSimplePats >> List.map (SynInfo.AttribsOfArgData >> TcAttrs AttributeTargets.Parameter false)) // Assert the return type of an active pattern. A [] attribute may be used on a partial active pattern. - let isStructRetTy = computeValWellKnownFlags g retAttribs &&& WellKnownValAttributes.StructAttribute <> WellKnownValAttributes.None + let isStructRetTy = attribsHaveValFlag g WellKnownValAttributes.StructAttribute retAttribs let argAndRetAttribs = ArgAndRetAttribs(argAttribs, retAttribs) @@ -11746,7 +11746,7 @@ and TcLetBinding (cenv: cenv) isUse env containerInfo declKind tpenv (synBinds, | _ when inlineFlag.ShouldInline -> error(Error(FSComp.SR.tcInvalidInlineSpecification(), m)) - | TPat_query _ when computeValWellKnownFlags g attrs &&& WellKnownValAttributes.LiteralAttribute <> WellKnownValAttributes.None -> + | TPat_query _ when attribsHaveValFlag g WellKnownValAttributes.LiteralAttribute attrs -> error(Error(FSComp.SR.tcLiteralAttributeCannotUseActivePattern(), m)) | _ -> @@ -13080,7 +13080,7 @@ let TcAndPublishValSpec (cenv: cenv, env, containerInfo: ContainerInfo, declKind match literalExprOpt with | None -> let hasLiteralAttr = - computeValWellKnownFlags g attrs &&& WellKnownValAttributes.LiteralAttribute <> WellKnownValAttributes.None + attribsHaveValFlag g WellKnownValAttributes.LiteralAttribute attrs if hasLiteralAttr then errorR(Error(FSComp.SR.tcLiteralAttributeRequiresConstantValue(), m)) None diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index ce20c49457e..ee658880e39 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -2649,9 +2649,7 @@ let CheckEntityDefn cenv env (tycon: Entity) = let m = f.Range // Check if it's marked unsafe let zeroInitUnsafe = - computeValWellKnownFlags g f.FieldAttribs - &&& WellKnownValAttributes.DefaultValueAttribute_True - <> WellKnownValAttributes.None + attribsHaveValFlag g WellKnownValAttributes.DefaultValueAttribute_True f.FieldAttribs if zeroInitUnsafe then let ty = f.FormalType @@ -2669,9 +2667,7 @@ let CheckEntityDefn cenv env (tycon: Entity) = let m = f.Range // Check if it's marked unsafe let zeroInitUnsafe = - computeValWellKnownFlags g f.FieldAttribs - &&& WellKnownValAttributes.DefaultValueAttribute_True - <> WellKnownValAttributes.None + attribsHaveValFlag g WellKnownValAttributes.DefaultValueAttribute_True f.FieldAttribs if zeroInitUnsafe then if not (TypeHasDefaultValue g m f.FormalType) then diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 34c29702c42..8dca161247c 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3876,6 +3876,10 @@ let mapILFlagToEntityFlag (flag: WellKnownILAttributes) : WellKnownEntityAttribu | WellKnownILAttributes.NoEagerConstraintApplicationAttribute -> WellKnownEntityAttributes.None | _ -> WellKnownEntityAttributes.None +/// Check if a raw attribute list has a specific well-known entity flag (ad-hoc, non-caching). +let inline attribsHaveEntityFlag g (flag: WellKnownEntityAttributes) (attribs: Attribs) = + computeEntityWellKnownFlags g attribs &&& flag <> WellKnownEntityAttributes.None + /// Map a WellKnownILAttributes flag to its WellKnownValAttributes equivalent. /// Check if an Entity has a specific well-known attribute, computing and caching flags if needed. let EntityHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownEntityAttributes) (entity: Entity) : bool = @@ -3969,6 +3973,10 @@ let computeValWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownValAtt flags +/// Check if a raw attribute list has a specific well-known val flag (ad-hoc, non-caching). +let inline attribsHaveValFlag g (flag: WellKnownValAttributes) (attribs: Attribs) = + computeValWellKnownFlags g attribs &&& flag <> WellKnownValAttributes.None + /// Check if an ArgReprInfo has a specific well-known attribute, computing and caching flags if needed. let ArgReprInfoHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownValAttributes) (argInfo: ArgReprInfo) : bool = let wa = argInfo.Attribs @@ -9781,8 +9789,7 @@ let rec TypeHasDefaultValueAux isNew g m ty = tcref.AllInstanceFieldsAsList // We can ignore fields with the DefaultValue(false) attribute |> List.filter (fun fld -> - let flags = computeValWellKnownFlags g fld.FieldAttribs - flags &&& WellKnownValAttributes.DefaultValueAttribute_False = WellKnownValAttributes.None) + not (attribsHaveValFlag g WellKnownValAttributes.DefaultValueAttribute_False fld.FieldAttribs)) flds |> List.forall (actualTyOfRecdField (mkTyconRefInst tcref tinst) >> TypeHasDefaultValueAux isNew g m) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index c3471fbf0b4..508c4a7d26e 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2399,6 +2399,10 @@ type ILFieldDef with val computeEntityWellKnownFlags: g: TcGlobals -> attribs: Attribs -> WellKnownEntityAttributes /// Check if an Entity has a specific well-known attribute, computing and caching flags if needed. +val inline attribsHaveEntityFlag: g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> bool + +val inline attribsHaveValFlag: g: TcGlobals -> flag: WellKnownValAttributes -> attribs: Attribs -> bool + val EntityHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownEntityAttributes -> entity: Entity -> bool /// Map a WellKnownILAttributes flag to its WellKnownEntityAttributes equivalent. From d644be64d02e9fe5e0be9d1a9d596f069d71b2b5 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 27 Feb 2026 19:14:04 +0100 Subject: [PATCH 35/71] Remove dead TryFindFSharpBoolAttribute helper (zero callers remain) All bool attribute checks now use cached flags via decodeBoolAttribFlag in compute functions or attribsHaveValFlag ad-hoc helpers. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TypedTreeOps.fs | 6 ------ src/Compiler/TypedTree/TypedTreeOps.fsi | 2 -- 2 files changed, 8 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 8dca161247c..aaea6c06c18 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3578,12 +3578,6 @@ let (|AttribStringArg|_|) = function AttribExpr(_, Expr.Const (Const.String n, _ let (|AttribElemStringArg|_|) = function ILAttribElem.String(n) -> n | _ -> None -let TryFindFSharpBoolAttribute g nm attrs = - match TryFindFSharpAttribute g nm attrs with - | Some(Attrib(_, _, [], _, _, _, _)) -> Some true - | Some(Attrib(_, _, [ AttribBoolArg b ], _, _, _, _)) -> Some b - | _ -> None - let TryFindFSharpInt32Attribute g nm attrs = match TryFindFSharpAttribute g nm attrs with | Some(Attrib(_, _, [ AttribInt32Arg b ], _, _, _, _)) -> Some b diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 508c4a7d26e..82d631ed64b 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2436,8 +2436,6 @@ val TryFindFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> Attrib val TryFindFSharpAttributeOpt: TcGlobals -> BuiltinAttribInfo option -> Attribs -> Attrib option -val TryFindFSharpBoolAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> bool option - val TryFindFSharpStringAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> string option val TryFindLocalizedFSharpStringAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> string option From a70827fca80f3fcd671673b93016a4739c4a609a Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 27 Feb 2026 20:14:08 +0100 Subject: [PATCH 36/71] Remove dead code and migrate remaining CompilationRepresentation/CompileAsEvent Dead code removed: - isThreadOrContextStatic (zero callers) - TryFindILAttributeOpt (zero callers) - enum_CompilationRepresentationAttribute_* constants (all 3, zero callers) Migrated to flags: - CompileAsEvent now uses attribsHaveValFlag internally - ModuleNameIsMangled now uses attribsHaveEntityFlag - MemberIsCompiledAsInstance Instance/Static uses computeEntityWellKnownFlags Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TypedTreeOps.fs | 35 +++++++++---------------- src/Compiler/TypedTree/TypedTreeOps.fsi | 4 --- 2 files changed, 12 insertions(+), 27 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index aaea6c06c18..503e6254d36 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3599,11 +3599,6 @@ let TryFindLocalizedFSharpStringAttribute g nm attrs = let TryFindILAttribute (AttribInfo (atref, _)) attrs = HasILAttribute atref attrs -let TryFindILAttributeOpt attr attrs = - match attr with - | Some (AttribInfo (atref, _)) -> HasILAttribute atref attrs - | _ -> false - let IsILAttrib (AttribInfo (builtInAttrRef, _)) attr = isILAttrib builtInAttrRef attr /// Compute well-known attribute flags for an ILAttributes collection. @@ -9567,10 +9562,6 @@ let XmlDocSigOfEntity (eref: EntityRef) = //-------------------------------------------------------------------------- -let enum_CompilationRepresentationAttribute_Static = 0b0000000000000001 -let enum_CompilationRepresentationAttribute_Instance = 0b0000000000000010 -let enum_CompilationRepresentationAttribute_ModuleSuffix = 0b0000000000000100 - let TyconHasUseNullAsTrueValueAttribute g (tycon: Tycon) = EntityHasWellKnownAttribute g WellKnownEntityAttributes.CompilationRepresentation_PermitNull tycon @@ -9937,11 +9928,10 @@ let mkIfThen (g: TcGlobals) m e1 e2 = mkCond DebugPointAtBinding.NoneAtInvisible m g.unit_ty e1 e2 (mkUnit g m) let ModuleNameIsMangled g attrs = - match TryFindFSharpInt32Attribute g g.attrib_CompilationRepresentationAttribute attrs with - | Some flags -> ((flags &&& enum_CompilationRepresentationAttribute_ModuleSuffix) <> 0) - | _ -> false + attribsHaveEntityFlag g WellKnownEntityAttributes.CompilationRepresentation_ModuleSuffix attrs -let CompileAsEvent g attrs = HasFSharpAttribute g g.attrib_CLIEventAttribute attrs +let CompileAsEvent g attrs = + attribsHaveValFlag g WellKnownValAttributes.CLIEventAttribute attrs let ValCompileAsEvent g (v: Val) = ValHasWellKnownAttribute g WellKnownValAttributes.CLIEventAttribute v @@ -9955,12 +9945,15 @@ let MemberIsCompiledAsInstance g parent isExtensionMember (membInfo: ValMemberIn membInfo.MemberFlags.IsInstance else // Otherwise check attributes to see if there is an explicit instance or explicit static flag - let explicitInstance, explicitStatic = - match TryFindFSharpInt32Attribute g g.attrib_CompilationRepresentationAttribute attrs with - | Some flags -> - ((flags &&& enum_CompilationRepresentationAttribute_Instance) <> 0), - ((flags &&& enum_CompilationRepresentationAttribute_Static) <> 0) - | _ -> false, false + let entityFlags = computeEntityWellKnownFlags g attrs + + let explicitInstance = + entityFlags &&& WellKnownEntityAttributes.CompilationRepresentation_Instance + <> WellKnownEntityAttributes.None + + let explicitStatic = + entityFlags &&& WellKnownEntityAttributes.CompilationRepresentation_Static + <> WellKnownEntityAttributes.None explicitInstance || (membInfo.MemberFlags.IsInstance && not explicitStatic && @@ -11785,10 +11778,6 @@ let BindUnitVars g (mvs: Val list, paramInfos: ArgReprInfo list, body) = [], mkLet DebugPointAtBinding.NoneAtInvisible v.Range v (mkUnit g v.Range) body | _ -> mvs, body -let isThreadOrContextStatic g attrs = - HasFSharpAttributeOpt g g.attrib_ThreadStaticAttribute attrs || - HasFSharpAttributeOpt g g.attrib_ContextStaticAttribute attrs - let mkUnitDelayLambda (g: TcGlobals) m e = let uv, _ = mkCompGenLocal m "unitVar" g.unit_ty mkLambda m uv (e, tyOfExpr g e) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 82d631ed64b..49a3edde344 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2374,8 +2374,6 @@ val IsILAttrib: BuiltinAttribInfo -> ILAttribute -> bool val TryFindILAttribute: BuiltinAttribInfo -> ILAttributes -> bool -val TryFindILAttributeOpt: BuiltinAttribInfo option -> ILAttributes -> bool - /// Compute well-known attribute flags for an ILAttributes collection. val computeILWellKnownFlags: _g: TcGlobals -> attrs: ILAttributes -> WellKnownILAttributes @@ -2823,8 +2821,6 @@ val allTopLevelValsOfModDef: ModuleOrNamespaceContents -> seq val BindUnitVars: TcGlobals -> Val list * ArgReprInfo list * Expr -> Val list * Expr -val isThreadOrContextStatic: TcGlobals -> Attrib list -> bool - val mkUnitDelayLambda: TcGlobals -> range -> Expr -> Expr val GenWitnessArgTys: TcGlobals -> TraitWitnessInfo -> TType list list From 6994285c9b69988684b1f7588f83b118ca200363 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 27 Feb 2026 20:19:44 +0100 Subject: [PATCH 37/71] Delete HasFSharpAttributeOpt (zero callers), migrate CheckFSharpAttributesForObsolete MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Eliminated helpers: - HasFSharpAttributeOpt: last caller inlined, function deleted - TryFindFSharpBoolAttribute: already deleted (prior commit) - TryFindFSharpBoolAttributeAssumeFalse: already deleted (prior commit) Migrated: - CheckFSharpAttributesForObsolete: ObsoleteAttribute + IsByRefLikeAttribute now use attribsHaveEntityFlag instead of HasFSharpAttribute/Opt - IlxGen NonSerialized: inlined HasFSharpAttributeOpt to HasFSharpAttribute Remaining HasFSharpAttribute callers (7): 3 typar-level, 3 assembly-level, 1 NonSerialized fallback — all deliberately deferred. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/AttributeChecking.fs | 14 +++++++------- src/Compiler/CodeGen/IlxGen.fs | 7 +++++-- src/Compiler/TypedTree/TypedTreeOps.fs | 2 -- src/Compiler/TypedTree/TypedTreeOps.fsi | 2 -- 4 files changed, 12 insertions(+), 13 deletions(-) diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index a96d8a0dd4a..07d249aeb8a 100755 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -471,13 +471,13 @@ let CheckFSharpAttributesForHidden g attribs = | _ -> false) /// Indicate if a list of F# attributes contains 'ObsoleteAttribute'. Used to suppress the item in intellisense. -let CheckFSharpAttributesForObsolete (g:TcGlobals) attribs = - not (isNil attribs) && - (HasFSharpAttribute g g.attrib_SystemObsolete attribs) && - // Exclude types marked with IsByRefLikeAttribute from being considered obsolete, - // even if ObsoleteAttribute is present. This avoids improper suppression of types - // like Span and ReadOnlySpan in completion lists due to their dual attributes. - not (HasFSharpAttributeOpt g g.attrib_IsByRefLikeAttribute_opt attribs) +let CheckFSharpAttributesForObsolete (g: TcGlobals) attribs = + not (isNil attribs) + && (attribsHaveEntityFlag g WellKnownEntityAttributes.ObsoleteAttribute attribs) + && // Exclude types marked with IsByRefLikeAttribute from being considered obsolete, + // even if ObsoleteAttribute is present. This avoids improper suppression of types + // like Span and ReadOnlySpan in completion lists due to their dual attributes. + not (attribsHaveEntityFlag g WellKnownEntityAttributes.IsByRefLikeAttribute attribs) /// Indicates if a list of F# attributes contains 'ObsoleteAttribute' or CompilerMessageAttribute', which has an IsHidden argument /// May be used to suppress items from intellisense. diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 972d62e6519..74bcbea22c4 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -8955,7 +8955,8 @@ and GenParamAttribs cenv paramTy attribs = || isOutByrefTy g paramTy let optionalFlag = - valFlags &&& WellKnownValAttributes.OptionalAttribute <> WellKnownValAttributes.None + valFlags &&& WellKnownValAttributes.OptionalAttribute + <> WellKnownValAttributes.None let defaultValue = TryFindFSharpAttributeOpt g g.attrib_DefaultParameterValueAttribute attribs @@ -11154,7 +11155,9 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option ] let ilNotSerialized = - HasFSharpAttributeOpt g g.attrib_NonSerializedAttribute attribs + match g.attrib_NonSerializedAttribute with + | Some attr -> HasFSharpAttribute g attr attribs + | None -> false let fattribs = attribs diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 503e6254d36..d9e56322b3e 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3549,8 +3549,6 @@ let IsMatchingFSharpAttribute g (AttribInfo(_, tcref)) (Attrib(tcref2, _, _, _, let HasFSharpAttribute g tref attrs = List.exists (IsMatchingFSharpAttribute g tref) attrs let TryFindFSharpAttribute g tref attrs = List.tryFind (IsMatchingFSharpAttribute g tref) attrs let TryFindFSharpAttributeOpt g tref attrs = match tref with None -> None | Some tref -> List.tryFind (IsMatchingFSharpAttribute g tref) attrs - -let HasFSharpAttributeOpt g trefOpt attrs = match trefOpt with Some tref -> List.exists (IsMatchingFSharpAttribute g tref) attrs | _ -> false let IsMatchingFSharpAttributeOpt g attrOpt (Attrib(tcref2, _, _, _, _, _, _)) = match attrOpt with Some (AttribInfo(_, tcref)) -> tyconRefEq g tcref tcref2 | _ -> false [] diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 49a3edde344..ea768a91cfa 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2428,8 +2428,6 @@ val IsMatchingFSharpAttributeOpt: TcGlobals -> BuiltinAttribInfo option -> Attri val HasFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> bool -val HasFSharpAttributeOpt: TcGlobals -> BuiltinAttribInfo option -> Attribs -> bool - val TryFindFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> Attrib option val TryFindFSharpAttributeOpt: TcGlobals -> BuiltinAttribInfo option -> Attribs -> Attrib option From 4e7815d0a54175091714b7afb79fadb0ad252e7a Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 27 Feb 2026 20:46:58 +0100 Subject: [PATCH 38/71] Prototype: classifyEntityAttrib + tryFindEntityAttribByFlag Factor computeEntityWellKnownFlags into two layers: - classifyEntityAttrib: classify a SINGLE attrib, return its flag - computeEntityWellKnownFlags: OR all flags (uses classifyEntityAttrib) - tryFindEntityAttribByFlag: find first attrib matching a flag This enables enum-powered data extraction: callers use the WellKnownEntityAttributes enum to both check existence (O(1) via cached flags) AND find the actual attrib for data extraction (O(N) only on hit, via classifyEntityAttrib). Demonstrate with 2 migrations: - IlxGen StructLayoutAttribute: tryFindEntityAttribByFlag replaces TryFindFSharpAttribute - CheckExpressions AttributeUsageAttribute: same pattern This commit is isolated and revertable. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../Checking/Expressions/CheckExpressions.fs | 2 +- src/Compiler/CodeGen/IlxGen.fs | 2 +- src/Compiler/TypedTree/TcGlobals.fs | 30 --- src/Compiler/TypedTree/TcGlobals.fsi | 30 --- src/Compiler/TypedTree/TypedTreeOps.fs | 229 +++++++++--------- src/Compiler/TypedTree/TypedTreeOps.fsi | 2 + 6 files changed, 116 insertions(+), 179 deletions(-) diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 796fb4ee992..691862620fd 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -11458,7 +11458,7 @@ and CheckAttributeUsage (g: TcGlobals) (mAttr: range) (tcref: TyconRef) (attrTgt (validOnDefault, inheritedDefault) else if EntityHasWellKnownAttribute g WellKnownEntityAttributes.AttributeUsageAttribute tcref.Deref then - match TryFindFSharpAttribute g g.attrib_AttributeUsageAttribute tcref.Attribs with + match tryFindEntityAttribByFlag g WellKnownEntityAttributes.AttributeUsageAttribute tcref.Attribs with | Some(Attrib(unnamedArgs = [ AttribInt32Arg validOn ])) -> validOn, inheritedDefault | Some(Attrib(unnamedArgs = [ AttribInt32Arg validOn; AttribBoolArg(_allowMultiple); AttribBoolArg inherited])) -> diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 74bcbea22c4..af8115e00a8 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -11597,7 +11597,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option | _ -> ILTypeDefLayout.Auto, ILDefaultPInvokeEncoding.Ansi if EntityHasWellKnownAttribute g WellKnownEntityAttributes.StructLayoutAttribute tycon then - match TryFindFSharpAttribute g g.attrib_StructLayoutAttribute tycon.Attribs with + match tryFindEntityAttribByFlag g WellKnownEntityAttributes.StructLayoutAttribute tycon.Attribs with | Some(Attrib(_, _, [ AttribInt32Arg layoutKind ], namedArgs, _, _, _)) -> let decoder = AttributeDecoder namedArgs let ilPack = decoder.FindInt32 "Pack" 0x0 diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 3e0bdfd0905..5a7637eb735 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -1462,9 +1462,6 @@ type TcGlobals( 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" - member val attrib_IUnknownConstantAttribute = tryFindSysAttrib "System.Runtime.CompilerServices.IUnknownConstantAttribute" - member val attrib_RequiresLocationAttribute = findSysAttrib "System.Runtime.CompilerServices.RequiresLocationAttribute" // 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. @@ -1483,8 +1480,6 @@ type TcGlobals( member val attrib_DllImportAttribute = tryFindSysAttrib "System.Runtime.InteropServices.DllImportAttribute" member val attrib_StructLayoutAttribute = findSysAttrib "System.Runtime.InteropServices.StructLayoutAttribute" member val attrib_TypeForwardedToAttribute = findSysAttrib "System.Runtime.CompilerServices.TypeForwardedToAttribute" - member val attrib_ComVisibleAttribute = findSysAttrib "System.Runtime.InteropServices.ComVisibleAttribute" - member val attrib_ComImportAttribute = tryFindSysAttrib "System.Runtime.InteropServices.ComImportAttribute" member val attrib_FieldOffsetAttribute = findSysAttrib "System.Runtime.InteropServices.FieldOffsetAttribute" member val attrib_MarshalAsAttribute = tryFindSysAttrib "System.Runtime.InteropServices.MarshalAsAttribute" member val attrib_InAttribute = findSysAttrib "System.Runtime.InteropServices.InAttribute" @@ -1492,38 +1487,29 @@ type TcGlobals( member val attrib_OptionalAttribute = tryFindSysAttrib "System.Runtime.InteropServices.OptionalAttribute" member val attrib_DefaultParameterValueAttribute = tryFindSysAttrib "System.Runtime.InteropServices.DefaultParameterValueAttribute" member val attrib_ThreadStaticAttribute = tryFindSysAttrib "System.ThreadStaticAttribute" - member val attrib_VolatileFieldAttribute = mk_MFCore_attrib "VolatileFieldAttribute" member val attrib_NoEagerConstraintApplicationAttribute = mk_MFCompilerServices_attrib "NoEagerConstraintApplicationAttribute" member val attrib_ContextStaticAttribute = tryFindSysAttrib "System.ContextStaticAttribute" member val attrib_FlagsAttribute = findSysAttrib "System.FlagsAttribute" member val attrib_DefaultMemberAttribute = findSysAttrib "System.Reflection.DefaultMemberAttribute" member val attrib_DebuggerDisplayAttribute = findSysAttrib "System.Diagnostics.DebuggerDisplayAttribute" - member val attrib_DebuggerTypeProxyAttribute = findSysAttrib "System.Diagnostics.DebuggerTypeProxyAttribute" member val attrib_PreserveSigAttribute = tryFindSysAttrib "System.Runtime.InteropServices.PreserveSigAttribute" member val attrib_MethodImplAttribute = findSysAttrib "System.Runtime.CompilerServices.MethodImplAttribute" member val attrib_ExtensionAttribute = findSysAttrib "System.Runtime.CompilerServices.ExtensionAttribute" - member val attrib_CallerLineNumberAttribute = findSysAttrib "System.Runtime.CompilerServices.CallerLineNumberAttribute" - member val attrib_CallerFilePathAttribute = findSysAttrib "System.Runtime.CompilerServices.CallerFilePathAttribute" member val attrib_CallerMemberNameAttribute = findSysAttrib "System.Runtime.CompilerServices.CallerMemberNameAttribute" - member val attrib_SkipLocalsInitAttribute = findSysAttrib "System.Runtime.CompilerServices.SkipLocalsInitAttribute" member val attrib_DecimalConstantAttribute = findSysAttrib "System.Runtime.CompilerServices.DecimalConstantAttribute" member val attribs_Unsupported = v_attribs_Unsupported - member val attrib_ProjectionParameterAttribute = mk_MFCore_attrib "ProjectionParameterAttribute" member val attrib_CustomOperationAttribute = mk_MFCore_attrib "CustomOperationAttribute" member val attrib_NonSerializedAttribute = tryFindSysAttrib "System.NonSerializedAttribute" member val attrib_AutoSerializableAttribute = mk_MFCore_attrib "AutoSerializableAttribute" - member val attrib_RequireQualifiedAccessAttribute = mk_MFCore_attrib "RequireQualifiedAccessAttribute" member val attrib_EntryPointAttribute = mk_MFCore_attrib "EntryPointAttribute" - member val attrib_DefaultAugmentationAttribute = mk_MFCore_attrib "DefaultAugmentationAttribute" member val attrib_CompilerMessageAttribute = mk_MFCore_attrib "CompilerMessageAttribute" member val attrib_ExperimentalAttribute = mk_MFCore_attrib "ExperimentalAttribute" member val attrib_UnverifiableAttribute = mk_MFCore_attrib "UnverifiableAttribute" member val attrib_LiteralAttribute = mk_MFCore_attrib "LiteralAttribute" member val attrib_ConditionalAttribute = findSysAttrib "System.Diagnostics.ConditionalAttribute" member val attrib_OptionalArgumentAttribute = mk_MFCore_attrib "OptionalArgumentAttribute" - member val attrib_RequiresExplicitTypeArgumentsAttribute = mk_MFCore_attrib "RequiresExplicitTypeArgumentsAttribute" member val attrib_DefaultValueAttribute = mk_MFCore_attrib "DefaultValueAttribute" member val attrib_ClassAttribute = mk_MFCore_attrib "ClassAttribute" member val attrib_InterfaceAttribute = mk_MFCore_attrib "InterfaceAttribute" @@ -1532,29 +1518,13 @@ type TcGlobals( member val attrib_CompiledNameAttribute = mk_MFCore_attrib "CompiledNameAttribute" member val attrib_AutoOpenAttribute = mk_MFCore_attrib "AutoOpenAttribute" member val attrib_InternalsVisibleToAttribute = findSysAttrib tname_InternalsVisibleToAttribute - member val attrib_CompilationRepresentationAttribute = mk_MFCore_attrib "CompilationRepresentationAttribute" member val attrib_CompilationArgumentCountsAttribute = mk_MFCore_attrib "CompilationArgumentCountsAttribute" member val attrib_CompilationMappingAttribute = mk_MFCore_attrib "CompilationMappingAttribute" - member val attrib_CLIEventAttribute = mk_MFCore_attrib "CLIEventAttribute" - member val attrib_InlineIfLambdaAttribute = mk_MFCore_attrib "InlineIfLambdaAttribute" - member val attrib_CLIMutableAttribute = mk_MFCore_attrib "CLIMutableAttribute" member val attrib_AllowNullLiteralAttribute = mk_MFCore_attrib "AllowNullLiteralAttribute" - member val attrib_NoEqualityAttribute = mk_MFCore_attrib "NoEqualityAttribute" - member val attrib_NoComparisonAttribute = mk_MFCore_attrib "NoComparisonAttribute" - member val attrib_CustomEqualityAttribute = mk_MFCore_attrib "CustomEqualityAttribute" - member val attrib_CustomComparisonAttribute = mk_MFCore_attrib "CustomComparisonAttribute" member val attrib_EqualityConditionalOnAttribute = mk_MFCore_attrib "EqualityConditionalOnAttribute" member val attrib_ComparisonConditionalOnAttribute = mk_MFCore_attrib "ComparisonConditionalOnAttribute" - member val attrib_ReferenceEqualityAttribute = mk_MFCore_attrib "ReferenceEqualityAttribute" - member val attrib_StructuralEqualityAttribute = mk_MFCore_attrib "StructuralEqualityAttribute" - member val attrib_StructuralComparisonAttribute = mk_MFCore_attrib "StructuralComparisonAttribute" member val attrib_SealedAttribute = mk_MFCore_attrib "SealedAttribute" - member val attrib_AbstractClassAttribute = mk_MFCore_attrib "AbstractClassAttribute" - member val attrib_GeneralizableValueAttribute = mk_MFCore_attrib "GeneralizableValueAttribute" member val attrib_MeasureAttribute = mk_MFCore_attrib "MeasureAttribute" - member val attrib_MeasureableAttribute = mk_MFCore_attrib "MeasureAnnotatedAbbreviationAttribute" - member val attrib_NoDynamicInvocationAttribute = mk_MFCore_attrib "NoDynamicInvocationAttribute" - member val attrib_NoCompilerInliningAttribute = mk_MFCore_attrib "NoCompilerInliningAttribute" member val attrib_WarnOnWithoutNullArgumentAttribute = mk_MFCore_attrib "WarnOnWithoutNullArgumentAttribute" member val attrib_SecurityAttribute = tryFindSysAttrib "System.Security.Permissions.SecurityAttribute" member val attrib_SecurityCriticalAttribute = findSysAttrib "System.Security.SecurityCriticalAttribute" diff --git a/src/Compiler/TypedTree/TcGlobals.fsi b/src/Compiler/TypedTree/TcGlobals.fsi index e69bc7b5e80..17e852b7bf4 100644 --- a/src/Compiler/TypedTree/TcGlobals.fsi +++ b/src/Compiler/TypedTree/TcGlobals.fsi @@ -306,7 +306,6 @@ type internal TcGlobals = member array_tcr_nice: TypedTree.EntityRef - member attrib_AbstractClassAttribute: BuiltinAttribInfo member attrib_AllowNullLiteralAttribute: BuiltinAttribInfo @@ -316,21 +315,15 @@ type internal TcGlobals = member attrib_AutoSerializableAttribute: BuiltinAttribInfo - member attrib_CLIEventAttribute: BuiltinAttribInfo - member attrib_CLIMutableAttribute: BuiltinAttribInfo - member attrib_CallerFilePathAttribute: BuiltinAttribInfo - member attrib_CallerLineNumberAttribute: BuiltinAttribInfo member attrib_CallerMemberNameAttribute: BuiltinAttribInfo member attrib_ClassAttribute: BuiltinAttribInfo - member attrib_ComImportAttribute: BuiltinAttribInfo option - member attrib_ComVisibleAttribute: BuiltinAttribInfo member attrib_ComparisonConditionalOnAttribute: BuiltinAttribInfo @@ -338,7 +331,6 @@ type internal TcGlobals = member attrib_CompilationMappingAttribute: BuiltinAttribInfo - member attrib_CompilationRepresentationAttribute: BuiltinAttribInfo member attrib_CompiledNameAttribute: BuiltinAttribInfo @@ -352,17 +344,13 @@ type internal TcGlobals = member attrib_ContextStaticAttribute: BuiltinAttribInfo option - member attrib_CustomComparisonAttribute: BuiltinAttribInfo - member attrib_CustomEqualityAttribute: BuiltinAttribInfo member attrib_CustomOperationAttribute: BuiltinAttribInfo member attrib_DebuggerDisplayAttribute: BuiltinAttribInfo - member attrib_DebuggerTypeProxyAttribute: BuiltinAttribInfo - member attrib_DefaultAugmentationAttribute: BuiltinAttribInfo member attrib_DefaultMemberAttribute: BuiltinAttribInfo @@ -386,15 +374,11 @@ type internal TcGlobals = member attrib_FlagsAttribute: BuiltinAttribInfo - member attrib_GeneralizableValueAttribute: BuiltinAttribInfo - member attrib_IDispatchConstantAttribute: BuiltinAttribInfo option - member attrib_IUnknownConstantAttribute: BuiltinAttribInfo option member attrib_InAttribute: BuiltinAttribInfo - member attrib_InlineIfLambdaAttribute: BuiltinAttribInfo member attrib_InterfaceAttribute: BuiltinAttribInfo @@ -410,21 +394,16 @@ type internal TcGlobals = member attrib_MeasureAttribute: BuiltinAttribInfo - member attrib_MeasureableAttribute: BuiltinAttribInfo member attrib_MemberNotNullWhenAttribute: BuiltinAttribInfo member attrib_MethodImplAttribute: BuiltinAttribInfo - member attrib_NoComparisonAttribute: BuiltinAttribInfo - member attrib_NoCompilerInliningAttribute: BuiltinAttribInfo - member attrib_NoDynamicInvocationAttribute: BuiltinAttribInfo member attrib_NoEagerConstraintApplicationAttribute: BuiltinAttribInfo - member attrib_NoEqualityAttribute: BuiltinAttribInfo member attrib_NonSerializedAttribute: BuiltinAttribInfo option @@ -446,19 +425,14 @@ type internal TcGlobals = member attrib_PreserveSigAttribute: BuiltinAttribInfo option - member attrib_ProjectionParameterAttribute: BuiltinAttribInfo - member attrib_ReferenceEqualityAttribute: BuiltinAttribInfo member attrib_ReflectedDefinitionAttribute: BuiltinAttribInfo - member attrib_RequireQualifiedAccessAttribute: BuiltinAttribInfo member attrib_RequiredMemberAttribute: BuiltinAttribInfo - member attrib_RequiresExplicitTypeArgumentsAttribute: BuiltinAttribInfo - member attrib_RequiresLocationAttribute: BuiltinAttribInfo member attrib_SealedAttribute: BuiltinAttribInfo @@ -470,7 +444,6 @@ type internal TcGlobals = member attrib_SetsRequiredMembersAttribute: BuiltinAttribInfo - member attrib_SkipLocalsInitAttribute: BuiltinAttribInfo member attrib_DecimalConstantAttribute: BuiltinAttribInfo @@ -478,9 +451,7 @@ type internal TcGlobals = member attrib_StructLayoutAttribute: BuiltinAttribInfo - member attrib_StructuralComparisonAttribute: BuiltinAttribInfo - member attrib_StructuralEqualityAttribute: BuiltinAttribInfo member attrib_SystemObsolete: BuiltinAttribInfo @@ -492,7 +463,6 @@ type internal TcGlobals = member attrib_UnverifiableAttribute: BuiltinAttribInfo - member attrib_VolatileFieldAttribute: BuiltinAttribInfo member attrib_WarnOnWithoutNullArgumentAttribute: BuiltinAttribInfo diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index d9e56322b3e..98e5620a197 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3708,133 +3708,128 @@ let inline decodeBoolAttribFlag (attrib: Attrib) trueFlag falseFlag defaultFlag | Attrib(_, _, [ AttribBoolArg b ], _, _, _, _) -> if b then trueFlag else falseFlag | _ -> defaultFlag -/// Compute well-known attribute flags for an Entity's Attrib list. -let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEntityAttributes = - let mutable flags = WellKnownEntityAttributes.None - - for attrib in attribs do - let (Attrib(tcref, _, _, _, _, _, _)) = attrib - - let fsharpCorePath = - resolveAttribPath g tcref (fun path -> - match path with - | [| "System"; "Runtime"; "CompilerServices"; name |] -> - match name with - | "ExtensionAttribute" -> flags <- flags ||| WellKnownEntityAttributes.ExtensionAttribute - | "IsReadOnlyAttribute" -> flags <- flags ||| WellKnownEntityAttributes.IsReadOnlyAttribute - | "SkipLocalsInitAttribute" -> flags <- flags ||| WellKnownEntityAttributes.SkipLocalsInitAttribute - | "IsByRefLikeAttribute" -> flags <- flags ||| WellKnownEntityAttributes.IsByRefLikeAttribute - | _ -> () - - | [| "System"; "Runtime"; "InteropServices"; name |] -> - match name with - | "StructLayoutAttribute" -> flags <- flags ||| WellKnownEntityAttributes.StructLayoutAttribute - | "DllImportAttribute" -> flags <- flags ||| WellKnownEntityAttributes.DllImportAttribute - | "ComVisibleAttribute" -> - flags <- - flags - ||| decodeBoolAttribFlag - attrib - WellKnownEntityAttributes.ComVisibleAttribute_True - WellKnownEntityAttributes.ComVisibleAttribute_False - WellKnownEntityAttributes.ComVisibleAttribute_True - | "ComImportAttribute" -> - flags <- - flags - ||| decodeBoolAttribFlag - attrib - WellKnownEntityAttributes.ComImportAttribute_True - WellKnownEntityAttributes.None - WellKnownEntityAttributes.ComImportAttribute_True - | _ -> () +/// Classify a single Entity-level attribute, returning its well-known flag (or None). +let classifyEntityAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownEntityAttributes = + let (Attrib(tcref, _, _, _, _, _, _)) = attrib + let mutable flag = WellKnownEntityAttributes.None - | [| "System"; "Diagnostics"; name |] -> - match name with - | "DebuggerTypeProxyAttribute" -> flags <- flags ||| WellKnownEntityAttributes.DebuggerTypeProxyAttribute - | _ -> () + let fsharpCorePath = + resolveAttribPath g tcref (fun path -> + match path with + | [| "System"; "Runtime"; "CompilerServices"; name |] -> + match name with + | "ExtensionAttribute" -> flag <- WellKnownEntityAttributes.ExtensionAttribute + | "IsReadOnlyAttribute" -> flag <- WellKnownEntityAttributes.IsReadOnlyAttribute + | "SkipLocalsInitAttribute" -> flag <- WellKnownEntityAttributes.SkipLocalsInitAttribute + | "IsByRefLikeAttribute" -> flag <- WellKnownEntityAttributes.IsByRefLikeAttribute + | _ -> () - | [| "System"; name |] -> - match name with - | "AttributeUsageAttribute" -> flags <- flags ||| WellKnownEntityAttributes.AttributeUsageAttribute - | "ObsoleteAttribute" -> flags <- flags ||| WellKnownEntityAttributes.ObsoleteAttribute - | _ -> () + | [| "System"; "Runtime"; "InteropServices"; name |] -> + match name with + | "StructLayoutAttribute" -> flag <- WellKnownEntityAttributes.StructLayoutAttribute + | "DllImportAttribute" -> flag <- WellKnownEntityAttributes.DllImportAttribute + | "ComVisibleAttribute" -> + flag <- + decodeBoolAttribFlag + attrib + WellKnownEntityAttributes.ComVisibleAttribute_True + WellKnownEntityAttributes.ComVisibleAttribute_False + WellKnownEntityAttributes.ComVisibleAttribute_True + | "ComImportAttribute" -> + flag <- + decodeBoolAttribFlag + attrib + WellKnownEntityAttributes.ComImportAttribute_True + WellKnownEntityAttributes.None + WellKnownEntityAttributes.ComImportAttribute_True + | _ -> () - | _ -> ()) + | [| "System"; "Diagnostics"; name |] -> + match name with + | "DebuggerTypeProxyAttribute" -> flag <- WellKnownEntityAttributes.DebuggerTypeProxyAttribute + | _ -> () - // ── FSharp.Core attributes (written once, used for both paths) ── - match fsharpCorePath with - | ValueSome path -> - match path with - | [| "Microsoft"; "FSharp"; "Core"; name |] -> + | [| "System"; name |] -> match name with - | "SealedAttribute" -> - flags <- - flags - ||| decodeBoolAttribFlag - attrib - WellKnownEntityAttributes.SealedAttribute_True - WellKnownEntityAttributes.SealedAttribute_False - WellKnownEntityAttributes.SealedAttribute_True - | "AbstractClassAttribute" -> flags <- flags ||| WellKnownEntityAttributes.AbstractClassAttribute - | "RequireQualifiedAccessAttribute" -> - flags <- flags ||| WellKnownEntityAttributes.RequireQualifiedAccessAttribute - | "AutoOpenAttribute" -> flags <- flags ||| WellKnownEntityAttributes.AutoOpenAttribute - | "NoEqualityAttribute" -> flags <- flags ||| WellKnownEntityAttributes.NoEqualityAttribute - | "NoComparisonAttribute" -> flags <- flags ||| WellKnownEntityAttributes.NoComparisonAttribute - | "StructuralEqualityAttribute" -> - flags <- flags ||| WellKnownEntityAttributes.StructuralEqualityAttribute - | "StructuralComparisonAttribute" -> - flags <- flags ||| WellKnownEntityAttributes.StructuralComparisonAttribute - | "CustomEqualityAttribute" -> flags <- flags ||| WellKnownEntityAttributes.CustomEqualityAttribute - | "CustomComparisonAttribute" -> - flags <- flags ||| WellKnownEntityAttributes.CustomComparisonAttribute - | "ReferenceEqualityAttribute" -> - flags <- flags ||| WellKnownEntityAttributes.ReferenceEqualityAttribute - | "DefaultAugmentationAttribute" -> - flags <- flags ||| decodeBoolAttribFlag attrib WellKnownEntityAttributes.DefaultAugmentationAttribute_True WellKnownEntityAttributes.DefaultAugmentationAttribute_False WellKnownEntityAttributes.DefaultAugmentationAttribute_True - | "CLIMutableAttribute" -> flags <- flags ||| WellKnownEntityAttributes.CLIMutableAttribute - | "AutoSerializableAttribute" -> - flags <- flags ||| decodeBoolAttribFlag attrib WellKnownEntityAttributes.AutoSerializableAttribute_True WellKnownEntityAttributes.AutoSerializableAttribute_False WellKnownEntityAttributes.AutoSerializableAttribute_True - | "ReflectedDefinitionAttribute" -> - flags <- flags ||| WellKnownEntityAttributes.ReflectedDefinitionAttribute - | "AllowNullLiteralAttribute" -> - flags <- - flags - ||| decodeBoolAttribFlag - attrib - WellKnownEntityAttributes.AllowNullLiteralAttribute_True - WellKnownEntityAttributes.AllowNullLiteralAttribute_False - WellKnownEntityAttributes.AllowNullLiteralAttribute_True - | "WarnOnWithoutNullArgumentAttribute" -> - flags <- flags ||| WellKnownEntityAttributes.WarnOnWithoutNullArgumentAttribute - | "ClassAttribute" -> flags <- flags ||| WellKnownEntityAttributes.ClassAttribute - | "InterfaceAttribute" -> flags <- flags ||| WellKnownEntityAttributes.InterfaceAttribute - | "StructAttribute" -> flags <- flags ||| WellKnownEntityAttributes.StructAttribute - | "MeasureAttribute" -> flags <- flags ||| WellKnownEntityAttributes.MeasureAttribute - | "MeasureAnnotatedAbbreviationAttribute" -> - flags <- flags ||| WellKnownEntityAttributes.MeasureableAttribute - | "CLIEventAttribute" -> flags <- flags ||| WellKnownEntityAttributes.CLIEventAttribute - | "CompilationRepresentationAttribute" -> - match attrib with - | Attrib(_, _, [ AttribInt32Arg v ], _, _, _, _) -> - if v &&& 0x01 <> 0 then - flags <- flags ||| WellKnownEntityAttributes.CompilationRepresentation_Static - - if v &&& 0x02 <> 0 then - flags <- flags ||| WellKnownEntityAttributes.CompilationRepresentation_Instance - - if v &&& 0x04 <> 0 then - flags <- flags ||| WellKnownEntityAttributes.CompilationRepresentation_ModuleSuffix - - if v &&& 0x08 <> 0 then - flags <- flags ||| WellKnownEntityAttributes.CompilationRepresentation_PermitNull - | _ -> () + | "AttributeUsageAttribute" -> flag <- WellKnownEntityAttributes.AttributeUsageAttribute + | "ObsoleteAttribute" -> flag <- WellKnownEntityAttributes.ObsoleteAttribute + | _ -> () + + | _ -> ()) + + match fsharpCorePath with + | ValueSome path -> + match path with + | [| "Microsoft"; "FSharp"; "Core"; name |] -> + match name with + | "SealedAttribute" -> + flag <- + decodeBoolAttribFlag + attrib + WellKnownEntityAttributes.SealedAttribute_True + WellKnownEntityAttributes.SealedAttribute_False + WellKnownEntityAttributes.SealedAttribute_True + | "AbstractClassAttribute" -> flag <- WellKnownEntityAttributes.AbstractClassAttribute + | "RequireQualifiedAccessAttribute" -> flag <- WellKnownEntityAttributes.RequireQualifiedAccessAttribute + | "AutoOpenAttribute" -> flag <- WellKnownEntityAttributes.AutoOpenAttribute + | "NoEqualityAttribute" -> flag <- WellKnownEntityAttributes.NoEqualityAttribute + | "NoComparisonAttribute" -> flag <- WellKnownEntityAttributes.NoComparisonAttribute + | "StructuralEqualityAttribute" -> flag <- WellKnownEntityAttributes.StructuralEqualityAttribute + | "StructuralComparisonAttribute" -> flag <- WellKnownEntityAttributes.StructuralComparisonAttribute + | "CustomEqualityAttribute" -> flag <- WellKnownEntityAttributes.CustomEqualityAttribute + | "CustomComparisonAttribute" -> flag <- WellKnownEntityAttributes.CustomComparisonAttribute + | "ReferenceEqualityAttribute" -> flag <- WellKnownEntityAttributes.ReferenceEqualityAttribute + | "DefaultAugmentationAttribute" -> + flag <- decodeBoolAttribFlag attrib WellKnownEntityAttributes.DefaultAugmentationAttribute_True WellKnownEntityAttributes.DefaultAugmentationAttribute_False WellKnownEntityAttributes.DefaultAugmentationAttribute_True + | "CLIMutableAttribute" -> flag <- WellKnownEntityAttributes.CLIMutableAttribute + | "AutoSerializableAttribute" -> + flag <- decodeBoolAttribFlag attrib WellKnownEntityAttributes.AutoSerializableAttribute_True WellKnownEntityAttributes.AutoSerializableAttribute_False WellKnownEntityAttributes.AutoSerializableAttribute_True + | "ReflectedDefinitionAttribute" -> flag <- WellKnownEntityAttributes.ReflectedDefinitionAttribute + | "AllowNullLiteralAttribute" -> + flag <- + decodeBoolAttribFlag + attrib + WellKnownEntityAttributes.AllowNullLiteralAttribute_True + WellKnownEntityAttributes.AllowNullLiteralAttribute_False + WellKnownEntityAttributes.AllowNullLiteralAttribute_True + | "WarnOnWithoutNullArgumentAttribute" -> flag <- WellKnownEntityAttributes.WarnOnWithoutNullArgumentAttribute + | "ClassAttribute" -> flag <- WellKnownEntityAttributes.ClassAttribute + | "InterfaceAttribute" -> flag <- WellKnownEntityAttributes.InterfaceAttribute + | "StructAttribute" -> flag <- WellKnownEntityAttributes.StructAttribute + | "MeasureAttribute" -> flag <- WellKnownEntityAttributes.MeasureAttribute + | "MeasureAnnotatedAbbreviationAttribute" -> flag <- WellKnownEntityAttributes.MeasureableAttribute + | "CLIEventAttribute" -> flag <- WellKnownEntityAttributes.CLIEventAttribute + | "CompilationRepresentationAttribute" -> + match attrib with + | Attrib(_, _, [ AttribInt32Arg v ], _, _, _, _) -> + if v &&& 0x01 <> 0 then + flag <- flag ||| WellKnownEntityAttributes.CompilationRepresentation_Static + if v &&& 0x02 <> 0 then + flag <- flag ||| WellKnownEntityAttributes.CompilationRepresentation_Instance + if v &&& 0x04 <> 0 then + flag <- flag ||| WellKnownEntityAttributes.CompilationRepresentation_ModuleSuffix + if v &&& 0x08 <> 0 then + flag <- flag ||| WellKnownEntityAttributes.CompilationRepresentation_PermitNull | _ -> () | _ -> () - | ValueNone -> () + | _ -> () + | ValueNone -> () + + flag +/// Compute well-known attribute flags for an Entity's Attrib list. +let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEntityAttributes = + let mutable flags = WellKnownEntityAttributes.None + for attrib in attribs do + flags <- flags ||| classifyEntityAttrib g attrib flags +/// Find the first attribute in a list that matches a specific well-known entity flag. +/// Uses flag guard for fast negative (O(1) when not present), then iterates on hit. +let tryFindEntityAttribByFlag (g: TcGlobals) (flag: WellKnownEntityAttributes) (attribs: Attribs) : Attrib option = + attribs + |> List.tryFind (fun attrib -> classifyEntityAttrib g attrib &&& flag <> WellKnownEntityAttributes.None) + #if !NO_TYPEPROVIDERS /// Map a WellKnownILAttributes flag to its AttribInfo equivalent. let mapILFlagToAttribInfo (g: TcGlobals) (flag: WellKnownILAttributes) : BuiltinAttribInfo option = diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index ea768a91cfa..50899b3d4af 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2399,6 +2399,8 @@ val computeEntityWellKnownFlags: g: TcGlobals -> attribs: Attribs -> WellKnownEn /// Check if an Entity has a specific well-known attribute, computing and caching flags if needed. val inline attribsHaveEntityFlag: g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> bool +val tryFindEntityAttribByFlag: g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> Attrib option + val inline attribsHaveValFlag: g: TcGlobals -> flag: WellKnownValAttributes -> attribs: Attribs -> bool val EntityHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownEntityAttributes -> entity: Entity -> bool From 2b36d84900a73eaeb2fa6fe2759869d800f45577 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 27 Feb 2026 20:50:34 +0100 Subject: [PATCH 39/71] Migrate NonSerializedAttribute to val flags MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Add NonSerializedAttribute to WellKnownValAttributes enum + compute function. Replace last HasFSharpAttribute caller with attribsHaveValFlag. HasFSharpAttribute callers now: 6 (3 typar-level, 3 assembly-level — deferred). HasFSharpAttributeOpt callers: 0 (fully deleted). Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/CodeGen/IlxGen.fs | 4 +--- src/Compiler/TypedTree/TypedTreeOps.fs | 1 + src/Compiler/TypedTree/WellKnownAttribs.fs | 1 + src/Compiler/TypedTree/WellKnownAttribs.fsi | 1 + 4 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index af8115e00a8..abdd28b30b8 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -11155,9 +11155,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option ] let ilNotSerialized = - match g.attrib_NonSerializedAttribute with - | Some attr -> HasFSharpAttribute g attr attribs - | None -> false + attribsHaveValFlag g WellKnownValAttributes.NonSerializedAttribute attribs let fattribs = attribs diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 98e5620a197..db099930fb8 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3915,6 +3915,7 @@ let computeValWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownValAtt | "ThreadStaticAttribute" -> flags <- flags ||| WellKnownValAttributes.ThreadStaticAttribute | "ContextStaticAttribute" -> flags <- flags ||| WellKnownValAttributes.ContextStaticAttribute | "ParamArrayAttribute" -> flags <- flags ||| WellKnownValAttributes.ParamArrayAttribute + | "NonSerializedAttribute" -> flags <- flags ||| WellKnownValAttributes.NonSerializedAttribute | _ -> () | _ -> ()) diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fs b/src/Compiler/TypedTree/WellKnownAttribs.fs index ca894000ce4..38d8e74a2b2 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fs +++ b/src/Compiler/TypedTree/WellKnownAttribs.fs @@ -89,6 +89,7 @@ type internal WellKnownValAttributes = | NoDynamicInvocationAttribute_False = (1uL <<< 28) | GeneralizableValueAttribute = (1uL <<< 29) | CLIEventAttribute = (1uL <<< 30) + | NonSerializedAttribute = (1uL <<< 31) | NotComputed = (1uL <<< 63) /// Generic wrapper for an item list together with cached well-known attribute flags. diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fsi b/src/Compiler/TypedTree/WellKnownAttribs.fsi index 8b4eb796e3f..24a0535082c 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fsi +++ b/src/Compiler/TypedTree/WellKnownAttribs.fsi @@ -87,6 +87,7 @@ type internal WellKnownValAttributes = | NoDynamicInvocationAttribute_False = (1uL <<< 28) | GeneralizableValueAttribute = (1uL <<< 29) | CLIEventAttribute = (1uL <<< 30) + | NonSerializedAttribute = (1uL <<< 31) | NotComputed = (1uL <<< 63) /// Generic wrapper for an item list together with cached well-known attribute flags. From 59e5d97716a9c1ef240a3a0169444cb78e6330a2 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 27 Feb 2026 21:07:16 +0100 Subject: [PATCH 40/71] Add tryFindEntityAttribString/Int32, delete TryFindFSharpInt32Attribute Add enum-powered data extraction helpers that use classifyEntityAttrib for O(1) negative guard, then extract string/int data on hit. Migrate StructLayoutAttribute int extraction in CheckDeclarations from TryFindFSharpInt32Attribute to tryFindEntityAttribInt32. TryFindFSharpInt32Attribute now has zero callers and is deleted. This commit is isolated and revertable. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/CheckDeclarations.fs | 2 +- src/Compiler/TypedTree/TypedTreeOps.fs | 17 ++++++++++++----- src/Compiler/TypedTree/TypedTreeOps.fsi | 6 ++++-- 3 files changed, 17 insertions(+), 8 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 7af64aac221..99fbc5b3348 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -3418,7 +3418,7 @@ module EstablishTypeDefinitionCores = // are only used on exactly the right kinds of type definitions and not in conjunction with other attributes. let hasMeasureableAttr = entityFlags &&& WellKnownEntityAttributes.MeasureableAttribute <> WellKnownEntityAttributes.None - let structLayoutAttr = TryFindFSharpInt32Attribute g g.attrib_StructLayoutAttribute attrs + let structLayoutAttr = tryFindEntityAttribInt32 g WellKnownEntityAttributes.StructLayoutAttribute attrs let hasAllowNullLiteralAttr = entityFlags &&& WellKnownEntityAttributes.AllowNullLiteralAttribute_True <> WellKnownEntityAttributes.None if hasAbstractAttr then diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index db099930fb8..c6f18641cb7 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3576,11 +3576,6 @@ let (|AttribStringArg|_|) = function AttribExpr(_, Expr.Const (Const.String n, _ let (|AttribElemStringArg|_|) = function ILAttribElem.String(n) -> n | _ -> None -let TryFindFSharpInt32Attribute g nm attrs = - match TryFindFSharpAttribute g nm attrs with - | Some(Attrib(_, _, [ AttribInt32Arg b ], _, _, _, _)) -> Some b - | _ -> None - let TryFindFSharpStringAttribute g nm attrs = match TryFindFSharpAttribute g nm attrs with | Some(Attrib(_, _, [ AttribStringArg b ], _, _, _, _)) -> Some b @@ -3830,6 +3825,18 @@ let tryFindEntityAttribByFlag (g: TcGlobals) (flag: WellKnownEntityAttributes) ( attribs |> List.tryFind (fun attrib -> classifyEntityAttrib g attrib &&& flag <> WellKnownEntityAttributes.None) +/// Extract a string value from a well-known entity attribute. O(1) negative via flags. +let tryFindEntityAttribString (g: TcGlobals) (flag: WellKnownEntityAttributes) (attribs: Attribs) : string option = + match tryFindEntityAttribByFlag g flag attribs with + | Some(Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> Some s + | _ -> None + +/// Extract an int32 value from a well-known entity attribute. O(1) negative via flags. +let tryFindEntityAttribInt32 (g: TcGlobals) (flag: WellKnownEntityAttributes) (attribs: Attribs) : int option = + match tryFindEntityAttribByFlag g flag attribs with + | Some(Attrib(_, _, [ AttribInt32Arg v ], _, _, _, _)) -> Some v + | _ -> None + #if !NO_TYPEPROVIDERS /// Map a WellKnownILAttributes flag to its AttribInfo equivalent. let mapILFlagToAttribInfo (g: TcGlobals) (flag: WellKnownILAttributes) : BuiltinAttribInfo option = diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 50899b3d4af..924d54aef95 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2401,6 +2401,10 @@ val inline attribsHaveEntityFlag: g: TcGlobals -> flag: WellKnownEntityAttribute val tryFindEntityAttribByFlag: g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> Attrib option +val tryFindEntityAttribString: g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> string option + +val tryFindEntityAttribInt32: g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> int option + val inline attribsHaveValFlag: g: TcGlobals -> flag: WellKnownValAttributes -> attribs: Attribs -> bool val EntityHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownEntityAttributes -> entity: Entity -> bool @@ -2438,8 +2442,6 @@ val TryFindFSharpStringAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> s val TryFindLocalizedFSharpStringAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> string option -val TryFindFSharpInt32Attribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> int32 option - /// Try to find a specific attribute on a type definition, where the attribute accepts a string argument. /// /// This is used to detect the 'DefaultMemberAttribute' and 'ConditionalAttribute' attributes (on type definitions) From aa66db9ff0dbe86108e651394726d9388c1342ce Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 27 Feb 2026 21:22:51 +0100 Subject: [PATCH 41/71] Add (|EntityAttrib|_|) and (|ValAttrib|_|) active patterns for enum-powered data extraction MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Factor computeEntityWellKnownFlags into classifyEntityAttrib (per-attrib) + fold. Factor computeValWellKnownFlags into classifyValAttrib (per-attrib) + fold. Active patterns use classifyEntityAttrib/classifyValAttrib to find the matching attrib by flag, then callers destructure the full Attrib in the pattern match — existence check AND data extraction in one expression. Before: match TryFindFSharpAttribute g g.attrib_MethodImplAttribute attrs with | Some(Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> flags | _ -> 0x0 After: match attrs with | ValAttrib g WellKnownValAttributes.MethodImplAttribute (Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> flags | _ -> 0x0 Migrated 7 callsites: - IlxGen: MethodImplAttribute, PreserveSigAttribute, FieldOffsetAttribute, StructLayoutAttribute - CheckExpressions: HasMethodImplNoInliningAttribute, AttributeUsageAttribute - CheckDeclarations: StructAttribute on ArgReprInfo - infos.fs: CallerMemberNameAttribute Added val flags: MethodImplAttribute, PreserveSigAttribute, FieldOffsetAttribute Deleted: TryFindFSharpInt32Attribute (zero callers), g.attrib_CallerMemberNameAttribute This commit is isolated and revertable. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/CheckDeclarations.fs | 9 +- .../Checking/Expressions/CheckExpressions.fs | 19 +- src/Compiler/Checking/infos.fs | 6 +- src/Compiler/CodeGen/IlxGen.fs | 99 +++++----- src/Compiler/TypedTree/TcGlobals.fs | 1 - src/Compiler/TypedTree/TcGlobals.fsi | 1 - src/Compiler/TypedTree/TypedTreeOps.fs | 169 +++++++++--------- src/Compiler/TypedTree/TypedTreeOps.fsi | 8 +- src/Compiler/TypedTree/WellKnownAttribs.fs | 3 + src/Compiler/TypedTree/WellKnownAttribs.fsi | 3 + 10 files changed, 166 insertions(+), 152 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 99fbc5b3348..07f60fc80b0 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -3418,7 +3418,10 @@ module EstablishTypeDefinitionCores = // are only used on exactly the right kinds of type definitions and not in conjunction with other attributes. let hasMeasureableAttr = entityFlags &&& WellKnownEntityAttributes.MeasureableAttribute <> WellKnownEntityAttributes.None - let structLayoutAttr = tryFindEntityAttribInt32 g WellKnownEntityAttributes.StructLayoutAttribute attrs + let structLayoutAttr = + match attrs with + | EntityAttrib g WellKnownEntityAttributes.StructLayoutAttribute (Attrib(_, _, [ AttribInt32Arg v ], _, _, _, _)) -> Some v + | _ -> None let hasAllowNullLiteralAttr = entityFlags &&& WellKnownEntityAttributes.AllowNullLiteralAttribute_True <> WellKnownEntityAttributes.None if hasAbstractAttr then @@ -3727,8 +3730,8 @@ module EstablishTypeDefinitionCores = if isOptionTy g ty || isValueOptionTy g ty then ty else - match TryFindFSharpAttribute g g.attrib_StructAttribute (argInfo.Attribs.AsList()) with - | Some (Attrib(range=m)) -> + match argInfo.Attribs.AsList() with + | ValAttrib g WellKnownValAttributes.StructAttribute (Attrib(range=m)) -> checkLanguageFeatureAndRecover g.langVersion LanguageFeature.SupportValueOptionsAsOptionalParameters m mkValueOptionTy g ty | _ -> diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 691862620fd..49db7097504 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -1354,10 +1354,10 @@ let CheckRequiredProperties (g:TcGlobals) (env: TcEnv) (cenv: TcFileState) (minf errorR(Error(FSComp.SR.tcMissingRequiredMembers details, mMethExpr)) let private HasMethodImplNoInliningAttribute g attrs = - match TryFindFSharpAttribute g g.attrib_MethodImplAttribute attrs with - // NO_INLINING = 8 - | Some (Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> (flags &&& 0x8) <> 0x0 - | _ -> false + match attrs with + // NO_INLINING = 8 + | ValAttrib g WellKnownValAttributes.MethodImplAttribute (Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> (flags &&& 0x8) <> 0x0 + | _ -> false let MakeAndPublishVal (cenv: cenv) env (altActualParent, inSig, declKind, valRecInfo, vscheme, attrs, xmlDoc, konst, isGeneratedEventVal) = @@ -11457,19 +11457,16 @@ and CheckAttributeUsage (g: TcGlobals) (mAttr: range) (tcref: TyconRef) (attrTgt | _ -> (validOnDefault, inheritedDefault) else - if EntityHasWellKnownAttribute g WellKnownEntityAttributes.AttributeUsageAttribute tcref.Deref then - match tryFindEntityAttribByFlag g WellKnownEntityAttributes.AttributeUsageAttribute tcref.Attribs with - | Some(Attrib(unnamedArgs = [ AttribInt32Arg validOn ])) -> + match tcref.Attribs with + | EntityAttrib g WellKnownEntityAttributes.AttributeUsageAttribute (Attrib(unnamedArgs = [ AttribInt32Arg validOn ])) -> validOn, inheritedDefault - | Some(Attrib(unnamedArgs = [ AttribInt32Arg validOn; AttribBoolArg(_allowMultiple); AttribBoolArg inherited])) -> + | EntityAttrib g WellKnownEntityAttributes.AttributeUsageAttribute (Attrib(unnamedArgs = [ AttribInt32Arg validOn; AttribBoolArg(_allowMultiple); AttribBoolArg inherited])) -> validOn, inherited - | Some _ -> + | EntityAttrib g WellKnownEntityAttributes.AttributeUsageAttribute _ -> warning(Error(FSComp.SR.tcUnexpectedConditionInImportedAssembly(), mAttr)) validOnDefault, inheritedDefault | _ -> validOnDefault, inheritedDefault - else - validOnDefault, inheritedDefault // Determine valid attribute targets let attributeTargets = enum validOn &&& attrTgt diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index 3fdfa6e2cdd..72510543261 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -324,9 +324,9 @@ let CrackParamAttribsInfo g (ty: TType, argInfo: ArgReprInfo) = | true, false, false -> CallerLineNumber | false, true, false -> CallerFilePath | false, false, true -> CallerMemberName - | false, true, true -> - match TryFindFSharpAttribute g g.attrib_CallerMemberNameAttribute attribs with - | Some(Attrib(_, _, _, _, _, _, callerMemberNameAttributeRange)) -> + | false, true, true -> + match attribs with + | ValAttrib g WellKnownValAttributes.CallerMemberNameAttribute (Attrib(_, _, _, _, _, _, callerMemberNameAttributeRange)) -> warning(Error(FSComp.SR.CallerMemberNameIsOverridden(argInfo.Name.Value.idText), callerMemberNameAttributeRange)) CallerFilePath | _ -> failwith "Impossible" diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index abdd28b30b8..cb841811f3b 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -9149,14 +9149,12 @@ and ComputeMethodImplAttribs cenv (_v: Val) attrs = let g = cenv.g let implflags = - match TryFindFSharpAttribute g g.attrib_MethodImplAttribute attrs with - | Some(Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> flags + match attrs with + | ValAttrib g WellKnownValAttributes.MethodImplAttribute (Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> flags | _ -> 0x0 let hasPreserveSigAttr = - match TryFindFSharpAttributeOpt g g.attrib_PreserveSigAttribute attrs with - | Some _ -> true - | _ -> false + attribsHaveValFlag g WellKnownValAttributes.PreserveSigAttribute attrs // strip the MethodImpl pseudo-custom attribute // The following method implementation flags are used here @@ -11138,10 +11136,16 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option for useGenuineField, ilFieldName, isFSharpMutable, isStatic, _, ilPropType, isPropHidden, fspec in fieldSummaries do let ilFieldOffset = - match TryFindFSharpAttribute g g.attrib_FieldOffsetAttribute fspec.FieldAttribs with - | Some(Attrib(_, _, [ AttribInt32Arg fieldOffset ], _, _, _, _)) -> Some fieldOffset - | Some attrib -> - errorR (Error(FSComp.SR.ilFieldOffsetAttributeCouldNotBeDecoded (), attrib.Range)) + match fspec.FieldAttribs with + | ValAttrib g WellKnownValAttributes.FieldOffsetAttribute (Attrib(_, + _, + [ AttribInt32Arg fieldOffset ], + _, + _, + _, + _)) -> Some fieldOffset + | ValAttrib g WellKnownValAttributes.FieldOffsetAttribute (Attrib(_, _, _, _, _, _, m)) -> + errorR (Error(FSComp.SR.ilFieldOffsetAttributeCouldNotBeDecoded (), m)) None | _ -> None @@ -11594,43 +11598,46 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option ILTypeDefLayout.Sequential { Size = Some 1; Pack = Some 0us }, ILDefaultPInvokeEncoding.Ansi | _ -> ILTypeDefLayout.Auto, ILDefaultPInvokeEncoding.Ansi - if EntityHasWellKnownAttribute g WellKnownEntityAttributes.StructLayoutAttribute tycon then - match tryFindEntityAttribByFlag g WellKnownEntityAttributes.StructLayoutAttribute tycon.Attribs with - | Some(Attrib(_, _, [ AttribInt32Arg layoutKind ], namedArgs, _, _, _)) -> - let decoder = AttributeDecoder namedArgs - let ilPack = decoder.FindInt32 "Pack" 0x0 - let ilSize = decoder.FindInt32 "Size" 0x0 - - let tdEncoding = - match (decoder.FindInt32 "CharSet" 0x0) with - (* enumeration values for System.Runtime.InteropServices.CharSet taken from mscorlib.il *) - | 0x03 -> ILDefaultPInvokeEncoding.Unicode - | 0x04 -> ILDefaultPInvokeEncoding.Auto - | _ -> ILDefaultPInvokeEncoding.Ansi - - let layoutInfo = - if ilPack = 0x0 && ilSize = 0x0 then - { Size = None; Pack = None } - else - { - Size = Some ilSize - Pack = Some(uint16 ilPack) - } - - let tdLayout = - match layoutKind with - (* enumeration values for System.Runtime.InteropServices.LayoutKind taken from mscorlib.il *) - | 0x0 -> ILTypeDefLayout.Sequential layoutInfo - | 0x2 -> ILTypeDefLayout.Explicit layoutInfo - | _ -> ILTypeDefLayout.Auto - - tdLayout, tdEncoding - | Some(Attrib(_, _, _, _, _, _, m)) -> - errorR (Error(FSComp.SR.ilStructLayoutAttributeCouldNotBeDecoded (), m)) - ILTypeDefLayout.Auto, ILDefaultPInvokeEncoding.Ansi - | _ -> defaultLayout () - else - defaultLayout () + match tycon.Attribs with + | EntityAttrib g WellKnownEntityAttributes.StructLayoutAttribute (Attrib(_, + _, + [ AttribInt32Arg layoutKind ], + namedArgs, + _, + _, + _)) -> + let decoder = AttributeDecoder namedArgs + let ilPack = decoder.FindInt32 "Pack" 0x0 + let ilSize = decoder.FindInt32 "Size" 0x0 + + let tdEncoding = + match (decoder.FindInt32 "CharSet" 0x0) with + (* enumeration values for System.Runtime.InteropServices.CharSet taken from mscorlib.il *) + | 0x03 -> ILDefaultPInvokeEncoding.Unicode + | 0x04 -> ILDefaultPInvokeEncoding.Auto + | _ -> ILDefaultPInvokeEncoding.Ansi + + let layoutInfo = + if ilPack = 0x0 && ilSize = 0x0 then + { Size = None; Pack = None } + else + { + Size = Some ilSize + Pack = Some(uint16 ilPack) + } + + let tdLayout = + match layoutKind with + (* enumeration values for System.Runtime.InteropServices.LayoutKind taken from mscorlib.il *) + | 0x0 -> ILTypeDefLayout.Sequential layoutInfo + | 0x2 -> ILTypeDefLayout.Explicit layoutInfo + | _ -> ILTypeDefLayout.Auto + + tdLayout, tdEncoding + | EntityAttrib g WellKnownEntityAttributes.StructLayoutAttribute (Attrib(_, _, _, _, _, _, m)) -> + errorR (Error(FSComp.SR.ilStructLayoutAttributeCouldNotBeDecoded (), m)) + ILTypeDefLayout.Auto, ILDefaultPInvokeEncoding.Ansi + | _ -> defaultLayout () // if the type's layout is Explicit, ensure that each field has a valid offset let validateExplicit (fdef: ILFieldDef) = diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 5a7637eb735..5018494c0e0 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -1495,7 +1495,6 @@ type TcGlobals( member val attrib_PreserveSigAttribute = tryFindSysAttrib "System.Runtime.InteropServices.PreserveSigAttribute" member val attrib_MethodImplAttribute = findSysAttrib "System.Runtime.CompilerServices.MethodImplAttribute" member val attrib_ExtensionAttribute = findSysAttrib "System.Runtime.CompilerServices.ExtensionAttribute" - member val attrib_CallerMemberNameAttribute = findSysAttrib "System.Runtime.CompilerServices.CallerMemberNameAttribute" member val attrib_DecimalConstantAttribute = findSysAttrib "System.Runtime.CompilerServices.DecimalConstantAttribute" member val attribs_Unsupported = v_attribs_Unsupported diff --git a/src/Compiler/TypedTree/TcGlobals.fsi b/src/Compiler/TypedTree/TcGlobals.fsi index 17e852b7bf4..b2275223c9d 100644 --- a/src/Compiler/TypedTree/TcGlobals.fsi +++ b/src/Compiler/TypedTree/TcGlobals.fsi @@ -319,7 +319,6 @@ type internal TcGlobals = - member attrib_CallerMemberNameAttribute: BuiltinAttribInfo member attrib_ClassAttribute: BuiltinAttribInfo diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index c6f18641cb7..d2aa8a718fa 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3825,17 +3825,11 @@ let tryFindEntityAttribByFlag (g: TcGlobals) (flag: WellKnownEntityAttributes) ( attribs |> List.tryFind (fun attrib -> classifyEntityAttrib g attrib &&& flag <> WellKnownEntityAttributes.None) -/// Extract a string value from a well-known entity attribute. O(1) negative via flags. -let tryFindEntityAttribString (g: TcGlobals) (flag: WellKnownEntityAttributes) (attribs: Attribs) : string option = - match tryFindEntityAttribByFlag g flag attribs with - | Some(Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> Some s - | _ -> None - -/// Extract an int32 value from a well-known entity attribute. O(1) negative via flags. -let tryFindEntityAttribInt32 (g: TcGlobals) (flag: WellKnownEntityAttributes) (attribs: Attribs) : int option = - match tryFindEntityAttribByFlag g flag attribs with - | Some(Attrib(_, _, [ AttribInt32Arg v ], _, _, _, _)) -> Some v - | _ -> None +/// Active pattern: find a well-known entity attribute and return the full Attrib. +/// Uses classifyEntityAttrib per-item (no cached flags needed). +[] +let (|EntityAttrib|_|) (g: TcGlobals) (flag: WellKnownEntityAttributes) (attribs: Attribs) = + tryFindEntityAttribByFlag g flag attribs |> ValueOption.ofOption #if !NO_TYPEPROVIDERS /// Map a WellKnownILAttributes flag to its AttribInfo equivalent. @@ -3882,87 +3876,94 @@ let EntityHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownEntityAttributes) else ea.HasWellKnownAttribute(flag) -let computeValWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownValAttributes = - let mutable flags = WellKnownValAttributes.None +/// Classify a single Val-level attribute, returning its well-known flag (or None). +let classifyValAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownValAttributes = + let (Attrib(tcref, _, _, _, _, _, _)) = attrib + let mutable flag = WellKnownValAttributes.None - for attrib in attribs do - let (Attrib(tcref, _, _, _, _, _, _)) = attrib - - let fsharpCorePath = - resolveAttribPath g tcref (fun path -> - match path with - | [| "System"; "Runtime"; "CompilerServices"; name |] -> - match name with - | "SkipLocalsInitAttribute" -> flags <- flags ||| WellKnownValAttributes.SkipLocalsInitAttribute - | "ExtensionAttribute" -> flags <- flags ||| WellKnownValAttributes.ExtensionAttribute - | "CallerMemberNameAttribute" -> - flags <- flags ||| WellKnownValAttributes.CallerMemberNameAttribute - | "CallerFilePathAttribute" -> flags <- flags ||| WellKnownValAttributes.CallerFilePathAttribute - | "CallerLineNumberAttribute" -> - flags <- flags ||| WellKnownValAttributes.CallerLineNumberAttribute - | _ -> () - - | [| "System"; "Runtime"; "InteropServices"; name |] -> - match name with - | "DllImportAttribute" -> flags <- flags ||| WellKnownValAttributes.DllImportAttribute - | "InAttribute" -> flags <- flags ||| WellKnownValAttributes.InAttribute - | "OutAttribute" -> flags <- flags ||| WellKnownValAttributes.OutAttribute - | "DefaultParameterValueAttribute" -> - flags <- flags ||| WellKnownValAttributes.DefaultParameterValueAttribute - | "OptionalAttribute" -> flags <- flags ||| WellKnownValAttributes.OptionalAttribute - | _ -> () - - | [| "System"; "Diagnostics"; name |] -> - match name with - | "ConditionalAttribute" -> flags <- flags ||| WellKnownValAttributes.ConditionalAttribute - | _ -> () - - | [| "System"; name |] -> - match name with - | "ThreadStaticAttribute" -> flags <- flags ||| WellKnownValAttributes.ThreadStaticAttribute - | "ContextStaticAttribute" -> flags <- flags ||| WellKnownValAttributes.ContextStaticAttribute - | "ParamArrayAttribute" -> flags <- flags ||| WellKnownValAttributes.ParamArrayAttribute - | "NonSerializedAttribute" -> flags <- flags ||| WellKnownValAttributes.NonSerializedAttribute - | _ -> () - - | _ -> ()) - - // ── FSharp.Core attributes ── - match fsharpCorePath with - | ValueSome path -> + let fsharpCorePath = + resolveAttribPath g tcref (fun path -> match path with - | [| "Microsoft"; "FSharp"; "Core"; name |] -> + | [| "System"; "Runtime"; "CompilerServices"; name |] -> + match name with + | "SkipLocalsInitAttribute" -> flag <- WellKnownValAttributes.SkipLocalsInitAttribute + | "ExtensionAttribute" -> flag <- WellKnownValAttributes.ExtensionAttribute + | "CallerMemberNameAttribute" -> flag <- WellKnownValAttributes.CallerMemberNameAttribute + | "CallerFilePathAttribute" -> flag <- WellKnownValAttributes.CallerFilePathAttribute + | "CallerLineNumberAttribute" -> flag <- WellKnownValAttributes.CallerLineNumberAttribute + | "MethodImplAttribute" -> flag <- WellKnownValAttributes.MethodImplAttribute + | _ -> () + + | [| "System"; "Runtime"; "InteropServices"; name |] -> + match name with + | "DllImportAttribute" -> flag <- WellKnownValAttributes.DllImportAttribute + | "InAttribute" -> flag <- WellKnownValAttributes.InAttribute + | "OutAttribute" -> flag <- WellKnownValAttributes.OutAttribute + | "DefaultParameterValueAttribute" -> flag <- WellKnownValAttributes.DefaultParameterValueAttribute + | "OptionalAttribute" -> flag <- WellKnownValAttributes.OptionalAttribute + | "PreserveSigAttribute" -> flag <- WellKnownValAttributes.PreserveSigAttribute + | "FieldOffsetAttribute" -> flag <- WellKnownValAttributes.FieldOffsetAttribute + | _ -> () + + | [| "System"; "Diagnostics"; name |] -> + match name with + | "ConditionalAttribute" -> flag <- WellKnownValAttributes.ConditionalAttribute + | _ -> () + + | [| "System"; name |] -> match name with - | "EntryPointAttribute" -> flags <- flags ||| WellKnownValAttributes.EntryPointAttribute - | "LiteralAttribute" -> flags <- flags ||| WellKnownValAttributes.LiteralAttribute - | "ReflectedDefinitionAttribute" -> - // TryFindFSharpBoolAttributeAssumeFalse semantics: no explicit arg defaults to false - flags <- flags ||| decodeBoolAttribFlag attrib WellKnownValAttributes.ReflectedDefinitionAttribute_True WellKnownValAttributes.ReflectedDefinitionAttribute_False WellKnownValAttributes.ReflectedDefinitionAttribute_False - | "RequiresExplicitTypeArgumentsAttribute" -> - flags <- flags ||| WellKnownValAttributes.RequiresExplicitTypeArgumentsAttribute - | "DefaultValueAttribute" -> - flags <- flags ||| decodeBoolAttribFlag attrib WellKnownValAttributes.DefaultValueAttribute_True WellKnownValAttributes.DefaultValueAttribute_False WellKnownValAttributes.DefaultValueAttribute_True - | "VolatileFieldAttribute" -> flags <- flags ||| WellKnownValAttributes.VolatileFieldAttribute - | "NoDynamicInvocationAttribute" -> - // TryFindFSharpBoolAttributeAssumeFalse semantics: no explicit arg defaults to false - flags <- flags ||| decodeBoolAttribFlag attrib WellKnownValAttributes.NoDynamicInvocationAttribute_True WellKnownValAttributes.NoDynamicInvocationAttribute_False WellKnownValAttributes.NoDynamicInvocationAttribute_False - | "OptionalArgumentAttribute" -> - flags <- flags ||| WellKnownValAttributes.OptionalArgumentAttribute - | "ProjectionParameterAttribute" -> - flags <- flags ||| WellKnownValAttributes.ProjectionParameterAttribute - | "InlineIfLambdaAttribute" -> flags <- flags ||| WellKnownValAttributes.InlineIfLambdaAttribute - | "StructAttribute" -> flags <- flags ||| WellKnownValAttributes.StructAttribute - | "NoCompilerInliningAttribute" -> - flags <- flags ||| WellKnownValAttributes.NoCompilerInliningAttribute - | "GeneralizableValueAttribute" -> - flags <- flags ||| WellKnownValAttributes.GeneralizableValueAttribute - | "CLIEventAttribute" -> flags <- flags ||| WellKnownValAttributes.CLIEventAttribute + | "ThreadStaticAttribute" -> flag <- WellKnownValAttributes.ThreadStaticAttribute + | "ContextStaticAttribute" -> flag <- WellKnownValAttributes.ContextStaticAttribute + | "ParamArrayAttribute" -> flag <- WellKnownValAttributes.ParamArrayAttribute + | "NonSerializedAttribute" -> flag <- WellKnownValAttributes.NonSerializedAttribute | _ -> () + + | _ -> ()) + + match fsharpCorePath with + | ValueSome path -> + match path with + | [| "Microsoft"; "FSharp"; "Core"; name |] -> + match name with + | "EntryPointAttribute" -> flag <- WellKnownValAttributes.EntryPointAttribute + | "LiteralAttribute" -> flag <- WellKnownValAttributes.LiteralAttribute + | "ReflectedDefinitionAttribute" -> + flag <- decodeBoolAttribFlag attrib WellKnownValAttributes.ReflectedDefinitionAttribute_True WellKnownValAttributes.ReflectedDefinitionAttribute_False WellKnownValAttributes.ReflectedDefinitionAttribute_False + | "RequiresExplicitTypeArgumentsAttribute" -> flag <- WellKnownValAttributes.RequiresExplicitTypeArgumentsAttribute + | "DefaultValueAttribute" -> + flag <- decodeBoolAttribFlag attrib WellKnownValAttributes.DefaultValueAttribute_True WellKnownValAttributes.DefaultValueAttribute_False WellKnownValAttributes.DefaultValueAttribute_True + | "VolatileFieldAttribute" -> flag <- WellKnownValAttributes.VolatileFieldAttribute + | "NoDynamicInvocationAttribute" -> + flag <- decodeBoolAttribFlag attrib WellKnownValAttributes.NoDynamicInvocationAttribute_True WellKnownValAttributes.NoDynamicInvocationAttribute_False WellKnownValAttributes.NoDynamicInvocationAttribute_False + | "OptionalArgumentAttribute" -> flag <- WellKnownValAttributes.OptionalArgumentAttribute + | "ProjectionParameterAttribute" -> flag <- WellKnownValAttributes.ProjectionParameterAttribute + | "InlineIfLambdaAttribute" -> flag <- WellKnownValAttributes.InlineIfLambdaAttribute + | "StructAttribute" -> flag <- WellKnownValAttributes.StructAttribute + | "NoCompilerInliningAttribute" -> flag <- WellKnownValAttributes.NoCompilerInliningAttribute + | "GeneralizableValueAttribute" -> flag <- WellKnownValAttributes.GeneralizableValueAttribute + | "CLIEventAttribute" -> flag <- WellKnownValAttributes.CLIEventAttribute | _ -> () - | ValueNone -> () + | _ -> () + | ValueNone -> () + + flag +let computeValWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownValAttributes = + let mutable flags = WellKnownValAttributes.None + for attrib in attribs do + flags <- flags ||| classifyValAttrib g attrib flags +/// Find the first attribute in a list that matches a specific well-known val flag. +let tryFindValAttribByFlag (g: TcGlobals) (flag: WellKnownValAttributes) (attribs: Attribs) : Attrib option = + attribs + |> List.tryFind (fun attrib -> classifyValAttrib g attrib &&& flag <> WellKnownValAttributes.None) + +/// Active pattern: find a well-known val attribute and return the full Attrib. +[] +let (|ValAttrib|_|) (g: TcGlobals) (flag: WellKnownValAttributes) (attribs: Attribs) = + tryFindValAttribByFlag g flag attribs |> ValueOption.ofOption + /// Check if a raw attribute list has a specific well-known val flag (ad-hoc, non-caching). let inline attribsHaveValFlag g (flag: WellKnownValAttributes) (attribs: Attribs) = computeValWellKnownFlags g attribs &&& flag <> WellKnownValAttributes.None diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 924d54aef95..ee404b049fd 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2401,12 +2401,14 @@ val inline attribsHaveEntityFlag: g: TcGlobals -> flag: WellKnownEntityAttribute val tryFindEntityAttribByFlag: g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> Attrib option -val tryFindEntityAttribString: g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> string option - -val tryFindEntityAttribInt32: g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> int option +[] +val (|EntityAttrib|_|): g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> Attrib voption val inline attribsHaveValFlag: g: TcGlobals -> flag: WellKnownValAttributes -> attribs: Attribs -> bool +[] +val (|ValAttrib|_|): g: TcGlobals -> flag: WellKnownValAttributes -> attribs: Attribs -> Attrib voption + val EntityHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownEntityAttributes -> entity: Entity -> bool /// Map a WellKnownILAttributes flag to its WellKnownEntityAttributes equivalent. diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fs b/src/Compiler/TypedTree/WellKnownAttribs.fs index 38d8e74a2b2..4c555179a8e 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fs +++ b/src/Compiler/TypedTree/WellKnownAttribs.fs @@ -90,6 +90,9 @@ type internal WellKnownValAttributes = | GeneralizableValueAttribute = (1uL <<< 29) | CLIEventAttribute = (1uL <<< 30) | NonSerializedAttribute = (1uL <<< 31) + | MethodImplAttribute = (1uL <<< 32) + | PreserveSigAttribute = (1uL <<< 33) + | FieldOffsetAttribute = (1uL <<< 34) | NotComputed = (1uL <<< 63) /// Generic wrapper for an item list together with cached well-known attribute flags. diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fsi b/src/Compiler/TypedTree/WellKnownAttribs.fsi index 24a0535082c..b07847c831a 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fsi +++ b/src/Compiler/TypedTree/WellKnownAttribs.fsi @@ -88,6 +88,9 @@ type internal WellKnownValAttributes = | GeneralizableValueAttribute = (1uL <<< 29) | CLIEventAttribute = (1uL <<< 30) | NonSerializedAttribute = (1uL <<< 31) + | MethodImplAttribute = (1uL <<< 32) + | PreserveSigAttribute = (1uL <<< 33) + | FieldOffsetAttribute = (1uL <<< 34) | NotComputed = (1uL <<< 63) /// Generic wrapper for an item list together with cached well-known attribute flags. From a994b1fbe21e68d52a5ab25035d9a039b40618e0 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Sat, 28 Feb 2026 10:05:18 +0100 Subject: [PATCH 42/71] Add typed extraction APs: EntityAttribInt, EntityAttribString, ValAttribInt, ValAttribString MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Slim active patterns that extract the common single-arg data directly: Before: | ValAttrib g WellKnownValAttributes.MethodImplAttribute (Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> flags After: | ValAttribInt g WellKnownValAttributes.MethodImplAttribute flags -> flags Migrated: MethodImplAttribute (×2), FieldOffsetAttribute, StructLayoutAttribute. Full (|EntityAttrib|_|) and (|ValAttrib|_|) remain for complex cases needing named args or multiple constructor args. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/CheckDeclarations.fs | 2 +- .../Checking/Expressions/CheckExpressions.fs | 2 +- src/Compiler/CodeGen/IlxGen.fs | 10 ++----- src/Compiler/TypedTree/TypedTreeOps.fs | 29 ++++++++++++++++++- src/Compiler/TypedTree/TypedTreeOps.fsi | 12 ++++++++ 5 files changed, 44 insertions(+), 11 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 07f60fc80b0..37c984177ee 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -3420,7 +3420,7 @@ module EstablishTypeDefinitionCores = let structLayoutAttr = match attrs with - | EntityAttrib g WellKnownEntityAttributes.StructLayoutAttribute (Attrib(_, _, [ AttribInt32Arg v ], _, _, _, _)) -> Some v + | EntityAttribInt g WellKnownEntityAttributes.StructLayoutAttribute v -> Some v | _ -> None let hasAllowNullLiteralAttr = entityFlags &&& WellKnownEntityAttributes.AllowNullLiteralAttribute_True <> WellKnownEntityAttributes.None diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 49db7097504..d6b7453baad 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -1356,7 +1356,7 @@ let CheckRequiredProperties (g:TcGlobals) (env: TcEnv) (cenv: TcFileState) (minf let private HasMethodImplNoInliningAttribute g attrs = match attrs with // NO_INLINING = 8 - | ValAttrib g WellKnownValAttributes.MethodImplAttribute (Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> (flags &&& 0x8) <> 0x0 + | ValAttribInt g WellKnownValAttributes.MethodImplAttribute flags -> (flags &&& 0x8) <> 0x0 | _ -> false let MakeAndPublishVal (cenv: cenv) env (altActualParent, inSig, declKind, valRecInfo, vscheme, attrs, xmlDoc, konst, isGeneratedEventVal) = diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index cb841811f3b..277298ea26e 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -9150,7 +9150,7 @@ and ComputeMethodImplAttribs cenv (_v: Val) attrs = let implflags = match attrs with - | ValAttrib g WellKnownValAttributes.MethodImplAttribute (Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> flags + | ValAttribInt g WellKnownValAttributes.MethodImplAttribute flags -> flags | _ -> 0x0 let hasPreserveSigAttr = @@ -11137,13 +11137,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option let ilFieldOffset = match fspec.FieldAttribs with - | ValAttrib g WellKnownValAttributes.FieldOffsetAttribute (Attrib(_, - _, - [ AttribInt32Arg fieldOffset ], - _, - _, - _, - _)) -> Some fieldOffset + | ValAttribInt g WellKnownValAttributes.FieldOffsetAttribute fieldOffset -> Some fieldOffset | ValAttrib g WellKnownValAttributes.FieldOffsetAttribute (Attrib(_, _, _, _, _, _, m)) -> errorR (Error(FSComp.SR.ilFieldOffsetAttributeCouldNotBeDecoded (), m)) None diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index d2aa8a718fa..51ec3ffa756 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3826,11 +3826,24 @@ let tryFindEntityAttribByFlag (g: TcGlobals) (flag: WellKnownEntityAttributes) ( |> List.tryFind (fun attrib -> classifyEntityAttrib g attrib &&& flag <> WellKnownEntityAttributes.None) /// Active pattern: find a well-known entity attribute and return the full Attrib. -/// Uses classifyEntityAttrib per-item (no cached flags needed). [] let (|EntityAttrib|_|) (g: TcGlobals) (flag: WellKnownEntityAttributes) (attribs: Attribs) = tryFindEntityAttribByFlag g flag attribs |> ValueOption.ofOption +/// Active pattern: extract a single int32 argument from a well-known entity attribute. +[] +let (|EntityAttribInt|_|) (g: TcGlobals) (flag: WellKnownEntityAttributes) (attribs: Attribs) = + match tryFindEntityAttribByFlag g flag attribs with + | Some(Attrib(_, _, [ AttribInt32Arg v ], _, _, _, _)) -> ValueSome v + | _ -> ValueNone + +/// Active pattern: extract a single string argument from a well-known entity attribute. +[] +let (|EntityAttribString|_|) (g: TcGlobals) (flag: WellKnownEntityAttributes) (attribs: Attribs) = + match tryFindEntityAttribByFlag g flag attribs with + | Some(Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> ValueSome s + | _ -> ValueNone + #if !NO_TYPEPROVIDERS /// Map a WellKnownILAttributes flag to its AttribInfo equivalent. let mapILFlagToAttribInfo (g: TcGlobals) (flag: WellKnownILAttributes) : BuiltinAttribInfo option = @@ -3964,6 +3977,20 @@ let tryFindValAttribByFlag (g: TcGlobals) (flag: WellKnownValAttributes) (attrib let (|ValAttrib|_|) (g: TcGlobals) (flag: WellKnownValAttributes) (attribs: Attribs) = tryFindValAttribByFlag g flag attribs |> ValueOption.ofOption +/// Active pattern: extract a single int32 argument from a well-known val attribute. +[] +let (|ValAttribInt|_|) (g: TcGlobals) (flag: WellKnownValAttributes) (attribs: Attribs) = + match tryFindValAttribByFlag g flag attribs with + | Some(Attrib(_, _, [ AttribInt32Arg v ], _, _, _, _)) -> ValueSome v + | _ -> ValueNone + +/// Active pattern: extract a single string argument from a well-known val attribute. +[] +let (|ValAttribString|_|) (g: TcGlobals) (flag: WellKnownValAttributes) (attribs: Attribs) = + match tryFindValAttribByFlag g flag attribs with + | Some(Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> ValueSome s + | _ -> ValueNone + /// Check if a raw attribute list has a specific well-known val flag (ad-hoc, non-caching). let inline attribsHaveValFlag g (flag: WellKnownValAttributes) (attribs: Attribs) = computeValWellKnownFlags g attribs &&& flag <> WellKnownValAttributes.None diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index ee404b049fd..00126a203a9 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2404,11 +2404,23 @@ val tryFindEntityAttribByFlag: g: TcGlobals -> flag: WellKnownEntityAttributes - [] val (|EntityAttrib|_|): g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> Attrib voption +[] +val (|EntityAttribInt|_|): g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> int voption + +[] +val (|EntityAttribString|_|): g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> string voption + val inline attribsHaveValFlag: g: TcGlobals -> flag: WellKnownValAttributes -> attribs: Attribs -> bool [] val (|ValAttrib|_|): g: TcGlobals -> flag: WellKnownValAttributes -> attribs: Attribs -> Attrib voption +[] +val (|ValAttribInt|_|): g: TcGlobals -> flag: WellKnownValAttributes -> attribs: Attribs -> int voption + +[] +val (|ValAttribString|_|): g: TcGlobals -> flag: WellKnownValAttributes -> attribs: Attribs -> string voption + val EntityHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownEntityAttributes -> entity: Entity -> bool /// Map a WellKnownILAttributes flag to its WellKnownEntityAttributes equivalent. From c98c3514c785cd87b010b4d6e0a113cec3cb5a7b Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Sat, 28 Feb 2026 11:59:59 +0100 Subject: [PATCH 43/71] Make typed APs compose on top of base (|EntityAttrib|_|) / (|ValAttrib|_|) EntityAttribInt/String now match via EntityAttrib internally instead of calling tryFindEntityAttribByFlag independently. Same for Val variants. Proper layering: base AP is the building block, typed APs are sugar. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TypedTreeOps.fs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 51ec3ffa756..525706d7b06 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3833,15 +3833,15 @@ let (|EntityAttrib|_|) (g: TcGlobals) (flag: WellKnownEntityAttributes) (attribs /// Active pattern: extract a single int32 argument from a well-known entity attribute. [] let (|EntityAttribInt|_|) (g: TcGlobals) (flag: WellKnownEntityAttributes) (attribs: Attribs) = - match tryFindEntityAttribByFlag g flag attribs with - | Some(Attrib(_, _, [ AttribInt32Arg v ], _, _, _, _)) -> ValueSome v + match attribs with + | EntityAttrib g flag (Attrib(_, _, [ AttribInt32Arg v ], _, _, _, _)) -> ValueSome v | _ -> ValueNone /// Active pattern: extract a single string argument from a well-known entity attribute. [] let (|EntityAttribString|_|) (g: TcGlobals) (flag: WellKnownEntityAttributes) (attribs: Attribs) = - match tryFindEntityAttribByFlag g flag attribs with - | Some(Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> ValueSome s + match attribs with + | EntityAttrib g flag (Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> ValueSome s | _ -> ValueNone #if !NO_TYPEPROVIDERS @@ -3980,15 +3980,15 @@ let (|ValAttrib|_|) (g: TcGlobals) (flag: WellKnownValAttributes) (attribs: Attr /// Active pattern: extract a single int32 argument from a well-known val attribute. [] let (|ValAttribInt|_|) (g: TcGlobals) (flag: WellKnownValAttributes) (attribs: Attribs) = - match tryFindValAttribByFlag g flag attribs with - | Some(Attrib(_, _, [ AttribInt32Arg v ], _, _, _, _)) -> ValueSome v + match attribs with + | ValAttrib g flag (Attrib(_, _, [ AttribInt32Arg v ], _, _, _, _)) -> ValueSome v | _ -> ValueNone /// Active pattern: extract a single string argument from a well-known val attribute. [] let (|ValAttribString|_|) (g: TcGlobals) (flag: WellKnownValAttributes) (attribs: Attribs) = - match tryFindValAttribByFlag g flag attribs with - | Some(Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> ValueSome s + match attribs with + | ValAttrib g flag (Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> ValueSome s | _ -> ValueNone /// Check if a raw attribute list has a specific well-known val flag (ad-hoc, non-caching). From 32746c952d3e5cb7c4e7b5ff652e78d52633f0fa Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Sat, 28 Feb 2026 14:38:34 +0100 Subject: [PATCH 44/71] A1: Add 7 entity/val flag cases, migrate 11 TryFindFSharpAttribute callers to APs MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit WellKnownEntityAttributes: CompilerMessage, Experimental, Unverifiable, EditorBrowsable, CompiledName added to enum + classifyEntityAttrib. WellKnownValAttributes: CompiledName, WarnOnWithoutNullArgument added. Migrated to EntityAttrib/ValAttrib/EntityAttribString/ValAttribString APs: - AttributeChecking.fs: Obsolete, CompilerMessage(×2), Experimental, Unverifiable, EditorBrowsable - CheckDeclarations.fs: CompiledName - CheckExpressions.fs: CompiledName(×2), WarnOnWithoutNullArgument(×2) - fsi.fs: EntryPoint TryFindFSharpAttribute callers: 15 → 8 Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/AttributeChecking.fs | 41 ++++++----------- src/Compiler/Checking/CheckDeclarations.fs | 6 ++- .../Checking/Expressions/CheckExpressions.fs | 46 ++++++++++++++----- src/Compiler/Interactive/fsi.fs | 8 ++-- src/Compiler/TypedTree/TypedTreeOps.fs | 11 +++++ src/Compiler/TypedTree/WellKnownAttribs.fs | 7 +++ src/Compiler/TypedTree/WellKnownAttribs.fsi | 7 +++ 7 files changed, 83 insertions(+), 43 deletions(-) diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index 07d249aeb8a..266df5fe235 100755 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -334,37 +334,27 @@ let private extractObsoleteAttributeInfo namedArgs = let private CheckObsoleteAttributes g attribs m = trackErrors { - match TryFindFSharpAttribute g g.attrib_SystemObsolete attribs with - // [] - // [] - // [] - // [] - // [] - // [] - // [] - // [] - // [] - // Constructors deciding on IsError and Message properties. - | Some(Attrib(unnamedArgs= [ AttribStringArg s ]; propVal= namedArgs)) -> + match attribs with + | EntityAttrib g WellKnownEntityAttributes.ObsoleteAttribute (Attrib(unnamedArgs= [ AttribStringArg s ]; propVal= namedArgs)) -> let diagnosticId, urlFormat = extractObsoleteAttributeInfo namedArgs do! WarnD(ObsoleteDiagnostic(false, diagnosticId, Some s, urlFormat, m)) - | Some(Attrib(unnamedArgs= [ AttribStringArg s; AttribBoolArg(isError) ]; propVal= namedArgs)) -> + | EntityAttrib g WellKnownEntityAttributes.ObsoleteAttribute (Attrib(unnamedArgs= [ AttribStringArg s; AttribBoolArg(isError) ]; propVal= namedArgs)) -> let diagnosticId, urlFormat = extractObsoleteAttributeInfo namedArgs if isError then do! ErrorD (ObsoleteDiagnostic(true, diagnosticId, Some s, urlFormat, m)) else do! WarnD (ObsoleteDiagnostic(false, diagnosticId, Some s, urlFormat, m)) // Only DiagnosticId, UrlFormat - | Some(Attrib(propVal= namedArgs)) -> + | EntityAttrib g WellKnownEntityAttributes.ObsoleteAttribute (Attrib(propVal= namedArgs)) -> let diagnosticId, urlFormat = extractObsoleteAttributeInfo namedArgs do! WarnD(ObsoleteDiagnostic(false, diagnosticId, None, urlFormat, m)) - | None -> () + | _ -> () } let private CheckCompilerMessageAttribute g attribs m = trackErrors { - match TryFindFSharpAttribute g g.attrib_CompilerMessageAttribute attribs with - | Some(Attrib(unnamedArgs= [ AttribStringArg s ; AttribInt32Arg n ]; propVal= namedArgs)) -> + match attribs with + | EntityAttrib g WellKnownEntityAttributes.CompilerMessageAttribute (Attrib(unnamedArgs= [ AttribStringArg s ; AttribInt32Arg n ]; propVal= namedArgs)) -> let msg = UserCompilerMessage(s, n, m) let isError = match namedArgs with @@ -384,9 +374,9 @@ let private CheckCompilerMessageAttribute g attribs m = let private CheckFSharpExperimentalAttribute g attribs m = trackErrors { - match TryFindFSharpAttribute g g.attrib_ExperimentalAttribute attribs with + match attribs with // [] - | Some(Attrib(unnamedArgs= [ AttribStringArg(s) ])) -> + | EntityAttrib g WellKnownEntityAttributes.ExperimentalAttribute (Attrib(unnamedArgs= [ AttribStringArg(s) ])) -> let isExperimentalAttributeDisabled (s:string) = if g.compilingFSharpCore then true @@ -395,14 +385,13 @@ let private CheckFSharpExperimentalAttribute g attribs m = if not (isExperimentalAttributeDisabled s) then do! WarnD(Experimental(Some s, None, None, m)) // Empty constructor is not allowed. - | Some _ | _ -> () } let private CheckUnverifiableAttribute g attribs m = trackErrors { - match TryFindFSharpAttribute g g.attrib_UnverifiableAttribute attribs with - | Some _ -> + match attribs with + | EntityAttrib g WellKnownEntityAttributes.UnverifiableAttribute _ -> do! WarnD(PossibleUnverifiableCode(m)) | _ -> () } @@ -462,12 +451,12 @@ let CheckILAttributesForUnseen (g: TcGlobals) cattrs _m = /// items to be suppressed from intellisense. let CheckFSharpAttributesForHidden g attribs = not (isNil attribs) && - (match TryFindFSharpAttribute g g.attrib_CompilerMessageAttribute attribs with - | Some(Attrib(_, _, _, ExtractAttribNamedArg "IsHidden" (AttribBoolArg v), _, _, _)) -> v + (match attribs with + | EntityAttrib g WellKnownEntityAttributes.CompilerMessageAttribute (Attrib(_, _, _, ExtractAttribNamedArg "IsHidden" (AttribBoolArg v), _, _, _)) -> v | _ -> false) || - (match TryFindFSharpAttribute g g.attrib_ComponentModelEditorBrowsableAttribute attribs with - | Some(Attrib(_, _, [AttribInt32Arg state], _, _, _, _)) -> state = int System.ComponentModel.EditorBrowsableState.Never + (match attribs with + | EntityAttrib g WellKnownEntityAttributes.EditorBrowsableAttribute (Attrib(_, _, [AttribInt32Arg state], _, _, _, _)) -> state = int System.ComponentModel.EditorBrowsableState.Never | _ -> false) /// Indicate if a list of F# attributes contains 'ObsoleteAttribute'. Used to suppress the item in intellisense. diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 37c984177ee..133f2f5f8a0 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -2888,7 +2888,11 @@ module EstablishTypeDefinitionCores = tycon.SetIsStructRecordOrUnion isStructRecordOrUnionType // Set the compiled name, if any - tycon.SetCompiledName (TryFindFSharpStringAttribute g g.attrib_CompiledNameAttribute attrs) + tycon.SetCompiledName( + match attrs with + | EntityAttribString g WellKnownEntityAttributes.CompiledNameAttribute s -> Some s + | _ -> None + ) if hasMeasureAttr then tycon.SetTypeOrMeasureKind TyparKind.Measure diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index d6b7453baad..ca8b30f5822 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -1415,7 +1415,10 @@ let MakeAndPublishVal (cenv: cenv) env (altActualParent, inSig, declKind, valRec // CompiledName not allowed on virtual/abstract/override members - let compiledNameAttrib = TryFindFSharpStringAttribute g g.attrib_CompiledNameAttribute attrs + let compiledNameAttrib = + match attrs with + | ValAttribString g WellKnownValAttributes.CompiledNameAttribute s -> Some s + | _ -> None if Option.isSome compiledNameAttrib then match memberInfoOpt with | Some (PrelimMemberInfo(memberInfo, _, _)) -> @@ -4485,10 +4488,10 @@ and TcTyparDecl (cenv: cenv) env synTyparDecl = let kind = if hasMeasureAttr then TyparKind.Measure else TyparKind.Type let tp = Construct.NewTypar (kind, TyparRigidity.WarnIfNotRigid, synTypar, false, TyparDynamicReq.Yes, attrs, hasEqDepAttr, hasCompDepAttr) - match TryFindFSharpStringAttribute g g.attrib_CompiledNameAttribute attrs with - | Some compiledName -> + match attrs with + | ValAttribString g WellKnownValAttributes.CompiledNameAttribute compiledName -> tp.SetILName (Some compiledName) - | None -> + | _ -> () let item = Item.TypeVar(id.idText, tp) @@ -5231,9 +5234,20 @@ and TcPatLongIdentActivePatternCase warnOnUpper (cenv: cenv) (env: TcEnv) vFlags let (APElemRef (apinfo, vref, idx, isStructRetTy)) = apref let cenv = - match g.checkNullness,TryFindLocalizedFSharpStringAttribute g g.attrib_WarnOnWithoutNullArgumentAttribute vref.Attribs with - | true, (Some _ as warnMsg) -> {cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = warnMsg} - | _ -> cenv + if g.checkNullness then + match vref.Attribs with + | ValAttrib g WellKnownValAttributes.WarnOnWithoutNullArgumentAttribute (Attrib(_, _, [ AttribStringArg b ], namedArgs, _, _, _)) -> + let warnMsg = + match namedArgs with + | ExtractAttribNamedArg "Localize" (AttribBoolArg true) -> FSComp.SR.GetTextOpt(b) + | _ -> Some b + + match warnMsg with + | Some _ -> { cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = warnMsg } + | None -> cenv + | _ -> cenv + else + cenv // Report information about the 'active recognizer' occurrence to IDE CallNameResolutionSink cenv.tcSink (mLongId, env.NameEnv, item, emptyTyparInst, ItemOccurrence.Pattern, env.eAccessRights) @@ -9426,12 +9440,22 @@ and TcValueItemThen cenv overallTy env vref tpenv mItem afterResolution delayed | _ -> vExpr, tpenv let getCenvForVref cenv (vref:ValRef) = - match TryFindLocalizedFSharpStringAttribute g g.attrib_WarnOnWithoutNullArgumentAttribute vref.Attribs with - | Some _ as msg -> { cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = msg} - | None when cenv.css.WarnWhenUsingWithoutNullOnAWithNullTarget <> None -> + match vref.Attribs with + | ValAttrib g WellKnownValAttributes.WarnOnWithoutNullArgumentAttribute (Attrib(_, _, [ AttribStringArg b ], namedArgs, _, _, _)) -> + let msg = + match namedArgs with + | ExtractAttribNamedArg "Localize" (AttribBoolArg true) -> FSComp.SR.GetTextOpt(b) + | _ -> Some b + + match msg with + | Some _ -> { cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = msg } + | None when cenv.css.WarnWhenUsingWithoutNullOnAWithNullTarget <> None -> + { cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = None } + | None -> cenv + | _ when cenv.css.WarnWhenUsingWithoutNullOnAWithNullTarget <> None -> // We need to reset the warning back to default once in a nested call, to prevent false warnings e.g. in `Option.ofObj (Path.GetDirectoryName "")` { cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = None} - | None -> cenv + | _ -> cenv let cenv = match vExpr with diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index dc78c5b82e3..f06c24c8068 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -2203,11 +2203,9 @@ type internal FsiDynamicCompiler /// Check FSI entries for the presence of EntryPointAttribute and issue a warning if it's found let CheckEntryPoint (tcGlobals: TcGlobals) (declaredImpls: CheckedImplFile list) = let tryGetEntryPoint (TBind(var = value)) = - if ValHasWellKnownAttribute tcGlobals WellKnownValAttributes.EntryPointAttribute value then - TryFindFSharpAttribute tcGlobals tcGlobals.attrib_EntryPointAttribute value.Attribs - |> Option.map (fun attrib -> value.DisplayName, attrib) - else - None + match value.Attribs with + | ValAttrib tcGlobals WellKnownValAttributes.EntryPointAttribute attrib -> Some(value.DisplayName, attrib) + | _ -> None let rec findEntryPointInContents = function diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 525706d7b06..2c67d1e0b59 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3744,6 +3744,11 @@ let classifyEntityAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownEntityAttrib | "DebuggerTypeProxyAttribute" -> flag <- WellKnownEntityAttributes.DebuggerTypeProxyAttribute | _ -> () + | [| "System"; "ComponentModel"; name |] -> + match name with + | "EditorBrowsableAttribute" -> flag <- WellKnownEntityAttributes.EditorBrowsableAttribute + | _ -> () + | [| "System"; name |] -> match name with | "AttributeUsageAttribute" -> flag <- WellKnownEntityAttributes.AttributeUsageAttribute @@ -3794,6 +3799,10 @@ let classifyEntityAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownEntityAttrib | "MeasureAttribute" -> flag <- WellKnownEntityAttributes.MeasureAttribute | "MeasureAnnotatedAbbreviationAttribute" -> flag <- WellKnownEntityAttributes.MeasureableAttribute | "CLIEventAttribute" -> flag <- WellKnownEntityAttributes.CLIEventAttribute + | "CompilerMessageAttribute" -> flag <- WellKnownEntityAttributes.CompilerMessageAttribute + | "ExperimentalAttribute" -> flag <- WellKnownEntityAttributes.ExperimentalAttribute + | "UnverifiableAttribute" -> flag <- WellKnownEntityAttributes.UnverifiableAttribute + | "CompiledNameAttribute" -> flag <- WellKnownEntityAttributes.CompiledNameAttribute | "CompilationRepresentationAttribute" -> match attrib with | Attrib(_, _, [ AttribInt32Arg v ], _, _, _, _) -> @@ -3955,6 +3964,8 @@ let classifyValAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownValAttributes = | "NoCompilerInliningAttribute" -> flag <- WellKnownValAttributes.NoCompilerInliningAttribute | "GeneralizableValueAttribute" -> flag <- WellKnownValAttributes.GeneralizableValueAttribute | "CLIEventAttribute" -> flag <- WellKnownValAttributes.CLIEventAttribute + | "CompiledNameAttribute" -> flag <- WellKnownValAttributes.CompiledNameAttribute + | "WarnOnWithoutNullArgumentAttribute" -> flag <- WellKnownValAttributes.WarnOnWithoutNullArgumentAttribute | _ -> () | _ -> () | ValueNone -> () diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fs b/src/Compiler/TypedTree/WellKnownAttribs.fs index 4c555179a8e..53141b4ca72 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fs +++ b/src/Compiler/TypedTree/WellKnownAttribs.fs @@ -51,6 +51,11 @@ type internal WellKnownEntityAttributes = | CLIEventAttribute = (1uL <<< 40) | SealedAttribute_False = (1uL <<< 41) | AllowNullLiteralAttribute_False = (1uL <<< 42) + | CompilerMessageAttribute = (1uL <<< 43) + | ExperimentalAttribute = (1uL <<< 44) + | UnverifiableAttribute = (1uL <<< 45) + | EditorBrowsableAttribute = (1uL <<< 46) + | CompiledNameAttribute = (1uL <<< 47) | NotComputed = (1uL <<< 63) /// Flags enum for well-known attributes on Val (values and members). @@ -93,6 +98,8 @@ type internal WellKnownValAttributes = | MethodImplAttribute = (1uL <<< 32) | PreserveSigAttribute = (1uL <<< 33) | FieldOffsetAttribute = (1uL <<< 34) + | CompiledNameAttribute = (1uL <<< 35) + | WarnOnWithoutNullArgumentAttribute = (1uL <<< 36) | NotComputed = (1uL <<< 63) /// Generic wrapper for an item list together with cached well-known attribute flags. diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fsi b/src/Compiler/TypedTree/WellKnownAttribs.fsi index b07847c831a..7fb095c9f77 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fsi +++ b/src/Compiler/TypedTree/WellKnownAttribs.fsi @@ -50,6 +50,11 @@ type internal WellKnownEntityAttributes = | CLIEventAttribute = (1uL <<< 40) | SealedAttribute_False = (1uL <<< 41) | AllowNullLiteralAttribute_False = (1uL <<< 42) + | CompilerMessageAttribute = (1uL <<< 43) + | ExperimentalAttribute = (1uL <<< 44) + | UnverifiableAttribute = (1uL <<< 45) + | EditorBrowsableAttribute = (1uL <<< 46) + | CompiledNameAttribute = (1uL <<< 47) | NotComputed = (1uL <<< 63) /// Flags enum for well-known attributes on Val (values and members). @@ -91,6 +96,8 @@ type internal WellKnownValAttributes = | MethodImplAttribute = (1uL <<< 32) | PreserveSigAttribute = (1uL <<< 33) | FieldOffsetAttribute = (1uL <<< 34) + | CompiledNameAttribute = (1uL <<< 35) + | WarnOnWithoutNullArgumentAttribute = (1uL <<< 36) | NotComputed = (1uL <<< 63) /// Generic wrapper for an item list together with cached well-known attribute flags. From 693d442045f9a9f235a7c05e3fa9b757d48f9557 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Sat, 28 Feb 2026 14:44:53 +0100 Subject: [PATCH 45/71] B1: Add WellKnownAssemblyAttributes, migrate all string attribute callers MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit New enum WellKnownAssemblyAttributes with AutoOpen, InternalsVisibleTo, AssemblyCulture, AssemblyVersion. classifyAssemblyAttrib + (|AssemblyAttribString|_|). Migrated 7 TryFindFSharpStringAttribute callers: - fsc.fs: InternalsVisibleTo - IncrementalBuild.fs: AutoOpen, IVT, AssemblyCulture, AssemblyVersion - TransparentCompiler.fs: AssemblyCulture, AssemblyVersion TryFindFSharpStringAttribute callers: 10 → 0 (can be deleted) TryFindLocalizedFSharpStringAttribute callers: 2 → 0 (can be deleted) Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Driver/fsc.fs | 5 ++- src/Compiler/Service/IncrementalBuild.fs | 28 +++++++++++--- src/Compiler/Service/TransparentCompiler.fs | 19 ++++----- src/Compiler/TypedTree/TypedTreeOps.fs | 43 +++++++++++++++++++++ src/Compiler/TypedTree/TypedTreeOps.fsi | 5 +++ src/Compiler/TypedTree/WellKnownAttribs.fs | 11 ++++++ src/Compiler/TypedTree/WellKnownAttribs.fsi | 10 +++++ 7 files changed, 102 insertions(+), 19 deletions(-) diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index a11231319dd..a9e3dbf6b2f 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -866,8 +866,9 @@ let main3 | MetadataAssemblyGeneration.ReferenceOnly | MetadataAssemblyGeneration.ReferenceOut _ -> let hasIvt = - TryFindFSharpStringAttribute tcGlobals tcGlobals.attrib_InternalsVisibleToAttribute topAttrs.assemblyAttrs - |> Option.isSome + match topAttrs.assemblyAttrs with + | AssemblyAttribString tcGlobals WellKnownAssemblyAttributes.InternalsVisibleToAttribute _ -> true + | _ -> false let observer = if hasIvt then PublicAndInternal else PublicOnly diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 048965bdb6f..9022aeca5db 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -637,9 +637,19 @@ type RawFSharpAssemblyDataBackedByLanguageService (tcConfig, tcGlobals, generate let _sigDataAttributes, sigDataResources = EncodeSignatureData(tcConfig, tcGlobals, exportRemapping, generatedCcu, outfile, true) GetResourceNameAndSignatureDataFuncs sigDataResources - let autoOpenAttrs = topAttrs.assemblyAttrs |> List.choose (List.singleton >> TryFindFSharpStringAttribute tcGlobals tcGlobals.attrib_AutoOpenAttribute) - - let ivtAttrs = topAttrs.assemblyAttrs |> List.choose (List.singleton >> TryFindFSharpStringAttribute tcGlobals tcGlobals.attrib_InternalsVisibleToAttribute) + let autoOpenAttrs = + topAttrs.assemblyAttrs + |> List.choose (fun attr -> + match [ attr ] with + | AssemblyAttribString tcGlobals WellKnownAssemblyAttributes.AutoOpenAttribute s -> Some s + | _ -> None) + + let ivtAttrs = + topAttrs.assemblyAttrs + |> List.choose (fun attr -> + match [ attr ] with + | AssemblyAttribString tcGlobals WellKnownAssemblyAttributes.InternalsVisibleToAttribute s -> Some s + | _ -> None) interface IRawFSharpAssemblyData with member _.GetAutoOpenAttributes() = autoOpenAttrs @@ -813,10 +823,16 @@ module IncrementalBuilderHelpers = with exn -> errorRecoveryNoRange exn None - let locale = TryFindFSharpStringAttribute tcGlobals (tcGlobals.FindSysAttrib "System.Reflection.AssemblyCultureAttribute") topAttrs.assemblyAttrs + let locale = + match topAttrs.assemblyAttrs with + | AssemblyAttribString tcGlobals WellKnownAssemblyAttributes.AssemblyCultureAttribute s -> Some s + | _ -> None + let assemVerFromAttrib = - TryFindFSharpStringAttribute tcGlobals (tcGlobals.FindSysAttrib "System.Reflection.AssemblyVersionAttribute") topAttrs.assemblyAttrs - |> Option.bind (fun v -> try Some (parseILVersion v) with _ -> None) + match topAttrs.assemblyAttrs with + | AssemblyAttribString tcGlobals WellKnownAssemblyAttributes.AssemblyVersionAttribute s -> + try Some(parseILVersion s) with _ -> None + | _ -> None let ver = match assemVerFromAttrib with | None -> tcConfig.version.GetVersionInfo(tcConfig.implicitIncludeDir) diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index b3e30745734..d7d37722231 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -1845,21 +1845,18 @@ type internal TransparentCompiler None let locale = - TryFindFSharpStringAttribute - tcGlobals - (tcGlobals.FindSysAttrib "System.Reflection.AssemblyCultureAttribute") - topAttrs.assemblyAttrs + match topAttrs.assemblyAttrs with + | AssemblyAttribString tcGlobals WellKnownAssemblyAttributes.AssemblyCultureAttribute s -> Some s + | _ -> None let assemVerFromAttrib = - TryFindFSharpStringAttribute - tcGlobals - (tcGlobals.FindSysAttrib "System.Reflection.AssemblyVersionAttribute") - topAttrs.assemblyAttrs - |> Option.bind (fun v -> + match topAttrs.assemblyAttrs with + | AssemblyAttribString tcGlobals WellKnownAssemblyAttributes.AssemblyVersionAttribute s -> try - Some(parseILVersion v) + Some(parseILVersion s) with _ -> - None) + None + | _ -> None let ver = match assemVerFromAttrib with diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 2c67d1e0b59..6870aeae13d 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3821,6 +3821,37 @@ let classifyEntityAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownEntityAttrib flag +/// Classify a single assembly-level attribute, returning its well-known flag (or None). +let classifyAssemblyAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownAssemblyAttributes = + let (Attrib(tcref, _, _, _, _, _, _)) = attrib + let mutable flag = WellKnownAssemblyAttributes.None + + let fsharpCorePath = + resolveAttribPath g tcref (fun path -> + match path with + | [| "System"; "Runtime"; "CompilerServices"; name |] -> + match name with + | "InternalsVisibleToAttribute" -> flag <- WellKnownAssemblyAttributes.InternalsVisibleToAttribute + | _ -> () + | [| "System"; "Reflection"; name |] -> + match name with + | "AssemblyCultureAttribute" -> flag <- WellKnownAssemblyAttributes.AssemblyCultureAttribute + | "AssemblyVersionAttribute" -> flag <- WellKnownAssemblyAttributes.AssemblyVersionAttribute + | _ -> () + | _ -> ()) + + match fsharpCorePath with + | ValueSome path -> + match path with + | [| "Microsoft"; "FSharp"; "Core"; name |] -> + match name with + | "AutoOpenAttribute" -> flag <- WellKnownAssemblyAttributes.AutoOpenAttribute + | _ -> () + | _ -> () + | ValueNone -> () + + flag + /// Compute well-known attribute flags for an Entity's Attrib list. let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEntityAttributes = let mutable flags = WellKnownEntityAttributes.None @@ -3853,6 +3884,18 @@ let (|EntityAttribString|_|) (g: TcGlobals) (flag: WellKnownEntityAttributes) (a | EntityAttrib g flag (Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> ValueSome s | _ -> ValueNone +/// Find the first attribute in a list that matches a specific well-known assembly flag. +let tryFindAssemblyAttribByFlag (g: TcGlobals) (flag: WellKnownAssemblyAttributes) (attribs: Attribs) : Attrib option = + attribs + |> List.tryFind (fun attrib -> classifyAssemblyAttrib g attrib &&& flag <> WellKnownAssemblyAttributes.None) + +/// Active pattern: extract a single string argument from a well-known assembly attribute. +[] +let (|AssemblyAttribString|_|) (g: TcGlobals) (flag: WellKnownAssemblyAttributes) (attribs: Attribs) = + match tryFindAssemblyAttribByFlag g flag attribs with + | Some(Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> ValueSome s + | _ -> ValueNone + #if !NO_TYPEPROVIDERS /// Map a WellKnownILAttributes flag to its AttribInfo equivalent. let mapILFlagToAttribInfo (g: TcGlobals) (flag: WellKnownILAttributes) : BuiltinAttribInfo option = diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 00126a203a9..9da0815d227 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2410,6 +2410,11 @@ val (|EntityAttribInt|_|): g: TcGlobals -> flag: WellKnownEntityAttributes -> at [] val (|EntityAttribString|_|): g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> string voption +val tryFindAssemblyAttribByFlag: g: TcGlobals -> flag: WellKnownAssemblyAttributes -> attribs: Attribs -> Attrib option + +[] +val (|AssemblyAttribString|_|): g: TcGlobals -> flag: WellKnownAssemblyAttributes -> attribs: Attribs -> string voption + val inline attribsHaveValFlag: g: TcGlobals -> flag: WellKnownValAttributes -> attribs: Attribs -> bool [] diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fs b/src/Compiler/TypedTree/WellKnownAttribs.fs index 53141b4ca72..ccc7e6e2fc1 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fs +++ b/src/Compiler/TypedTree/WellKnownAttribs.fs @@ -58,6 +58,17 @@ type internal WellKnownEntityAttributes = | CompiledNameAttribute = (1uL <<< 47) | NotComputed = (1uL <<< 63) +/// Flags enum for well-known assembly-level attributes. +/// Used to avoid O(N) linear scans of attribute lists. +[] +type internal WellKnownAssemblyAttributes = + | None = 0u + | AutoOpenAttribute = (1u <<< 0) + | InternalsVisibleToAttribute = (1u <<< 1) + | AssemblyCultureAttribute = (1u <<< 2) + | AssemblyVersionAttribute = (1u <<< 3) + | NotComputed = (1u <<< 31) + /// Flags enum for well-known attributes on Val (values and members). /// Used to avoid O(N) linear scans of attribute lists. [] diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fsi b/src/Compiler/TypedTree/WellKnownAttribs.fsi index 7fb095c9f77..62b2e4912ad 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fsi +++ b/src/Compiler/TypedTree/WellKnownAttribs.fsi @@ -57,6 +57,16 @@ type internal WellKnownEntityAttributes = | CompiledNameAttribute = (1uL <<< 47) | NotComputed = (1uL <<< 63) +/// Flags enum for well-known assembly-level attributes. +[] +type internal WellKnownAssemblyAttributes = + | None = 0u + | AutoOpenAttribute = (1u <<< 0) + | InternalsVisibleToAttribute = (1u <<< 1) + | AssemblyCultureAttribute = (1u <<< 2) + | AssemblyVersionAttribute = (1u <<< 3) + | NotComputed = (1u <<< 31) + /// Flags enum for well-known attributes on Val (values and members). [] type internal WellKnownValAttributes = From c05fd9d11662c9b5df875b8260cacde62307a796 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Sat, 28 Feb 2026 14:47:51 +0100 Subject: [PATCH 46/71] Delete dead helpers and g.attrib_ members after AP migration Dead helpers removed (zero callers): - TryFindFSharpStringAttribute - TryFindLocalizedFSharpStringAttribute Dead g.attrib_ members removed (zero callers outside TcGlobals): - attrib_CompilerMessageAttribute - attrib_ExperimentalAttribute - attrib_UnverifiableAttribute - attrib_InternalsVisibleToAttribute - attrib_WarnOnWithoutNullArgumentAttribute - attrib_ComponentModelEditorBrowsableAttribute Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TcGlobals.fs | 6 ------ src/Compiler/TypedTree/TcGlobals.fsi | 13 ------------- src/Compiler/TypedTree/TypedTreeOps.fs | 13 ------------- src/Compiler/TypedTree/TypedTreeOps.fsi | 4 ---- 4 files changed, 36 deletions(-) diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 5018494c0e0..9766f2cb7b7 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -1503,9 +1503,6 @@ type TcGlobals( member val attrib_AutoSerializableAttribute = mk_MFCore_attrib "AutoSerializableAttribute" member val attrib_EntryPointAttribute = mk_MFCore_attrib "EntryPointAttribute" - member val attrib_CompilerMessageAttribute = mk_MFCore_attrib "CompilerMessageAttribute" - member val attrib_ExperimentalAttribute = mk_MFCore_attrib "ExperimentalAttribute" - member val attrib_UnverifiableAttribute = mk_MFCore_attrib "UnverifiableAttribute" member val attrib_LiteralAttribute = mk_MFCore_attrib "LiteralAttribute" member val attrib_ConditionalAttribute = findSysAttrib "System.Diagnostics.ConditionalAttribute" member val attrib_OptionalArgumentAttribute = mk_MFCore_attrib "OptionalArgumentAttribute" @@ -1516,7 +1513,6 @@ type TcGlobals( member val attrib_ReflectedDefinitionAttribute = mk_MFCore_attrib "ReflectedDefinitionAttribute" member val attrib_CompiledNameAttribute = mk_MFCore_attrib "CompiledNameAttribute" member val attrib_AutoOpenAttribute = mk_MFCore_attrib "AutoOpenAttribute" - member val attrib_InternalsVisibleToAttribute = findSysAttrib tname_InternalsVisibleToAttribute member val attrib_CompilationArgumentCountsAttribute = mk_MFCore_attrib "CompilationArgumentCountsAttribute" member val attrib_CompilationMappingAttribute = mk_MFCore_attrib "CompilationMappingAttribute" member val attrib_AllowNullLiteralAttribute = mk_MFCore_attrib "AllowNullLiteralAttribute" @@ -1524,11 +1520,9 @@ type TcGlobals( member val attrib_ComparisonConditionalOnAttribute = mk_MFCore_attrib "ComparisonConditionalOnAttribute" member val attrib_SealedAttribute = mk_MFCore_attrib "SealedAttribute" member val attrib_MeasureAttribute = mk_MFCore_attrib "MeasureAttribute" - member val attrib_WarnOnWithoutNullArgumentAttribute = mk_MFCore_attrib "WarnOnWithoutNullArgumentAttribute" member val attrib_SecurityAttribute = tryFindSysAttrib "System.Security.Permissions.SecurityAttribute" member val attrib_SecurityCriticalAttribute = findSysAttrib "System.Security.SecurityCriticalAttribute" member val attrib_SecuritySafeCriticalAttribute = findSysAttrib "System.Security.SecuritySafeCriticalAttribute" - member val attrib_ComponentModelEditorBrowsableAttribute = findSysAttrib "System.ComponentModel.EditorBrowsableAttribute" member val attrib_CompilerFeatureRequiredAttribute = findSysAttrib "System.Runtime.CompilerServices.CompilerFeatureRequiredAttribute" member val attrib_SetsRequiredMembersAttribute = findSysAttrib "System.Diagnostics.CodeAnalysis.SetsRequiredMembersAttribute" member val attrib_RequiredMemberAttribute = findSysAttrib "System.Runtime.CompilerServices.RequiredMemberAttribute" diff --git a/src/Compiler/TypedTree/TcGlobals.fsi b/src/Compiler/TypedTree/TcGlobals.fsi index b2275223c9d..1ba2e0a7fba 100644 --- a/src/Compiler/TypedTree/TcGlobals.fsi +++ b/src/Compiler/TypedTree/TcGlobals.fsi @@ -335,10 +335,6 @@ type internal TcGlobals = member attrib_CompilerFeatureRequiredAttribute: BuiltinAttribInfo - member attrib_CompilerMessageAttribute: BuiltinAttribInfo - - member attrib_ComponentModelEditorBrowsableAttribute: BuiltinAttribInfo - member attrib_ConditionalAttribute: BuiltinAttribInfo member attrib_ContextStaticAttribute: BuiltinAttribInfo option @@ -365,8 +361,6 @@ type internal TcGlobals = member attrib_EqualityConditionalOnAttribute: BuiltinAttribInfo - member attrib_ExperimentalAttribute: BuiltinAttribInfo - member attrib_ExtensionAttribute: BuiltinAttribInfo member attrib_FieldOffsetAttribute: BuiltinAttribInfo @@ -381,8 +375,6 @@ type internal TcGlobals = member attrib_InterfaceAttribute: BuiltinAttribInfo - member attrib_InternalsVisibleToAttribute: BuiltinAttribInfo - member attrib_IsReadOnlyAttribute: BuiltinAttribInfo member attrib_IsUnmanagedAttribute: BuiltinAttribInfo @@ -460,11 +452,6 @@ type internal TcGlobals = member attrib_TypeForwardedToAttribute: BuiltinAttribInfo - member attrib_UnverifiableAttribute: BuiltinAttribInfo - - - member attrib_WarnOnWithoutNullArgumentAttribute: BuiltinAttribInfo - member attrib_IlExperimentalAttribute: BuiltinAttribInfo member attribs_Unsupported: TypedTree.TyconRef list diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 6870aeae13d..2d3f0784194 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3576,19 +3576,6 @@ let (|AttribStringArg|_|) = function AttribExpr(_, Expr.Const (Const.String n, _ let (|AttribElemStringArg|_|) = function ILAttribElem.String(n) -> n | _ -> None -let TryFindFSharpStringAttribute g nm attrs = - match TryFindFSharpAttribute g nm attrs with - | Some(Attrib(_, _, [ AttribStringArg b ], _, _, _, _)) -> Some b - | _ -> None - -let TryFindLocalizedFSharpStringAttribute g nm attrs = - match TryFindFSharpAttribute g nm attrs with - | Some(Attrib(_, _, [ AttribStringArg b ], namedArgs, _, _, _)) -> - match namedArgs with - | ExtractAttribNamedArg "Localize" (AttribBoolArg true) -> FSComp.SR.GetTextOpt(b) - | _ -> Some b - | _ -> None - let TryFindILAttribute (AttribInfo (atref, _)) attrs = HasILAttribute atref attrs diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 9da0815d227..82166f6a61c 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2457,10 +2457,6 @@ val TryFindFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> Attrib val TryFindFSharpAttributeOpt: TcGlobals -> BuiltinAttribInfo option -> Attribs -> Attrib option -val TryFindFSharpStringAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> string option - -val TryFindLocalizedFSharpStringAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> string option - /// Try to find a specific attribute on a type definition, where the attribute accepts a string argument. /// /// This is used to detect the 'DefaultMemberAttribute' and 'ConditionalAttribute' attributes (on type definitions) From 3fffcee477110d5b2e066c0dc74a5ad7388e931d Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Sat, 28 Feb 2026 14:52:52 +0100 Subject: [PATCH 47/71] C3: Shared combinators tryFindAttribByClassifier + attribsHaveFlag MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Extract inline combinators parameterized by classify function and zero value. Entity/Val/Assembly tryFind and attribsHave functions become thin wrappers: let tryFindEntityAttribByFlag g flag attribs = tryFindAttribByClassifier classifyEntityAttrib WellKnownEntityAttributes.None g flag attribs let attribsHaveValFlag g flag attribs = attribsHaveFlag classifyValAttrib WellKnownValAttributes.None g flag attribs Eliminates 3×duplicated tryFind + 2×duplicated attribsHave implementations. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TypedTreeOps.fs | 34 ++++++++++++++----------- src/Compiler/TypedTree/TypedTreeOps.fsi | 4 +-- 2 files changed, 21 insertions(+), 17 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 2d3f0784194..9eed5f7e2e4 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3839,6 +3839,14 @@ let classifyAssemblyAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownAssemblyAt flag +/// Shared combinator: find first attrib matching a flag via a classify function. +let inline internal tryFindAttribByClassifier ([] classify: TcGlobals -> Attrib -> 'Flag) (none: 'Flag) (g: TcGlobals) (flag: 'Flag) (attribs: Attribs) : Attrib option = + attribs |> List.tryFind (fun attrib -> classify g attrib &&& flag <> none) + +/// Shared combinator: check if any attrib in a list matches a flag via a classify function. +let inline internal attribsHaveFlag ([] classify: TcGlobals -> Attrib -> 'Flag) (none: 'Flag) (g: TcGlobals) (flag: 'Flag) (attribs: Attribs) : bool = + attribs |> List.exists (fun attrib -> classify g attrib &&& flag <> none) + /// Compute well-known attribute flags for an Entity's Attrib list. let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEntityAttributes = let mutable flags = WellKnownEntityAttributes.None @@ -3846,11 +3854,9 @@ let computeEntityWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownEnt flags <- flags ||| classifyEntityAttrib g attrib flags -/// Find the first attribute in a list that matches a specific well-known entity flag. -/// Uses flag guard for fast negative (O(1) when not present), then iterates on hit. -let tryFindEntityAttribByFlag (g: TcGlobals) (flag: WellKnownEntityAttributes) (attribs: Attribs) : Attrib option = - attribs - |> List.tryFind (fun attrib -> classifyEntityAttrib g attrib &&& flag <> WellKnownEntityAttributes.None) +/// Find the first attribute matching a specific well-known entity flag. +let tryFindEntityAttribByFlag g flag attribs = + tryFindAttribByClassifier classifyEntityAttrib WellKnownEntityAttributes.None g flag attribs /// Active pattern: find a well-known entity attribute and return the full Attrib. [] @@ -3872,9 +3878,8 @@ let (|EntityAttribString|_|) (g: TcGlobals) (flag: WellKnownEntityAttributes) (a | _ -> ValueNone /// Find the first attribute in a list that matches a specific well-known assembly flag. -let tryFindAssemblyAttribByFlag (g: TcGlobals) (flag: WellKnownAssemblyAttributes) (attribs: Attribs) : Attrib option = - attribs - |> List.tryFind (fun attrib -> classifyAssemblyAttrib g attrib &&& flag <> WellKnownAssemblyAttributes.None) +let tryFindAssemblyAttribByFlag g flag attribs = + tryFindAttribByClassifier classifyAssemblyAttrib WellKnownAssemblyAttributes.None g flag attribs /// Active pattern: extract a single string argument from a well-known assembly attribute. [] @@ -3912,8 +3917,8 @@ let mapILFlagToEntityFlag (flag: WellKnownILAttributes) : WellKnownEntityAttribu | _ -> WellKnownEntityAttributes.None /// Check if a raw attribute list has a specific well-known entity flag (ad-hoc, non-caching). -let inline attribsHaveEntityFlag g (flag: WellKnownEntityAttributes) (attribs: Attribs) = - computeEntityWellKnownFlags g attribs &&& flag <> WellKnownEntityAttributes.None +let attribsHaveEntityFlag g (flag: WellKnownEntityAttributes) (attribs: Attribs) = + attribsHaveFlag classifyEntityAttrib WellKnownEntityAttributes.None g flag attribs /// Map a WellKnownILAttributes flag to its WellKnownValAttributes equivalent. /// Check if an Entity has a specific well-known attribute, computing and caching flags if needed. @@ -4009,9 +4014,8 @@ let computeValWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownValAtt flags /// Find the first attribute in a list that matches a specific well-known val flag. -let tryFindValAttribByFlag (g: TcGlobals) (flag: WellKnownValAttributes) (attribs: Attribs) : Attrib option = - attribs - |> List.tryFind (fun attrib -> classifyValAttrib g attrib &&& flag <> WellKnownValAttributes.None) +let tryFindValAttribByFlag g flag attribs = + tryFindAttribByClassifier classifyValAttrib WellKnownValAttributes.None g flag attribs /// Active pattern: find a well-known val attribute and return the full Attrib. [] @@ -4033,8 +4037,8 @@ let (|ValAttribString|_|) (g: TcGlobals) (flag: WellKnownValAttributes) (attribs | _ -> ValueNone /// Check if a raw attribute list has a specific well-known val flag (ad-hoc, non-caching). -let inline attribsHaveValFlag g (flag: WellKnownValAttributes) (attribs: Attribs) = - computeValWellKnownFlags g attribs &&& flag <> WellKnownValAttributes.None +let attribsHaveValFlag g (flag: WellKnownValAttributes) (attribs: Attribs) = + attribsHaveFlag classifyValAttrib WellKnownValAttributes.None g flag attribs /// Check if an ArgReprInfo has a specific well-known attribute, computing and caching flags if needed. let ArgReprInfoHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownValAttributes) (argInfo: ArgReprInfo) : bool = diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 82166f6a61c..0c9bc871c62 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2397,7 +2397,7 @@ type ILFieldDef with val computeEntityWellKnownFlags: g: TcGlobals -> attribs: Attribs -> WellKnownEntityAttributes /// Check if an Entity has a specific well-known attribute, computing and caching flags if needed. -val inline attribsHaveEntityFlag: g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> bool +val attribsHaveEntityFlag: g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> bool val tryFindEntityAttribByFlag: g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> Attrib option @@ -2415,7 +2415,7 @@ val tryFindAssemblyAttribByFlag: g: TcGlobals -> flag: WellKnownAssemblyAttribut [] val (|AssemblyAttribString|_|): g: TcGlobals -> flag: WellKnownAssemblyAttributes -> attribs: Attribs -> string voption -val inline attribsHaveValFlag: g: TcGlobals -> flag: WellKnownValAttributes -> attribs: Attribs -> bool +val attribsHaveValFlag: g: TcGlobals -> flag: WellKnownValAttributes -> attribs: Attribs -> bool [] val (|ValAttrib|_|): g: TcGlobals -> flag: WellKnownValAttributes -> attribs: Attribs -> Attrib voption From 4e750f47b815af470df3f8a40d4838ac85d3da42 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Sun, 1 Mar 2026 19:34:03 +0100 Subject: [PATCH 48/71] Migrate remaining IsMatchingFSharpAttribute/TryFindFSharpAttribute to flag-based APIs - Add DebuggerDisplayAttribute to WellKnownEntityAttributes and classifyEntityAttrib - Add MarshalAsAttribute to WellKnownValAttributes and classifyValAttrib - Export classifyEntityAttrib, classifyValAttrib, filterOutWellKnownAttribs, and tryFindValAttribByFlag from TypedTreeOps.fsi - NicePrint.fs: Replace 13 serial filters with single filterOutWellKnownAttribs call - NicePrint.fs: Replace OptionalArgumentAttribute filter - IlxGen.fs: Migrate 14 filter sites and 4 TryFind data-extraction sites - CheckExpressions.fs: Replace MeasureAttribute filter - CheckDeclarations.fs: Replace ConditionalAttribute tryFind - TypedTreeOps.fs: Replace ExtensionAttribute tryFind - NameResolution.fs: Replace IsMatchingFSharpAttribute for StructAttribute - infos.fs: Replace DefaultParameterValueAttribute TryFindOpt Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/CheckDeclarations.fs | 2 +- .../Checking/Expressions/CheckExpressions.fs | 2 +- src/Compiler/Checking/NameResolution.fs | 2 +- src/Compiler/Checking/NicePrint.fs | 38 +++++++------ src/Compiler/Checking/infos.fs | 2 +- src/Compiler/CodeGen/IlxGen.fs | 53 +++++++++++-------- src/Compiler/TypedTree/TypedTreeOps.fs | 20 ++++++- src/Compiler/TypedTree/TypedTreeOps.fsi | 15 ++++++ src/Compiler/TypedTree/WellKnownAttribs.fs | 2 + src/Compiler/TypedTree/WellKnownAttribs.fsi | 2 + 10 files changed, 95 insertions(+), 43 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 133f2f5f8a0..c31675e52ea 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -3810,7 +3810,7 @@ module EstablishTypeDefinitionCores = errorR(Error(FSComp.SR.tcInvalidUseNullAsTrueValue(), m)) // validate ConditionalAttribute, should it be applied (it's only valid on a type if the type is an attribute type) - match attrs |> List.tryFind (IsMatchingFSharpAttribute g g.attrib_ConditionalAttribute) with + match tryFindValAttribByFlag g WellKnownValAttributes.ConditionalAttribute attrs with | Some _ -> if not(ExistsInEntireHierarchyOfType (fun t -> typeEquiv g t (mkWoNullAppTy g.tcref_System_Attribute [])) g cenv.amap m AllowMultiIntfInstantiations.Yes thisTy) then errorR(Error(FSComp.SR.tcConditionalAttributeUsage(), m)) diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index ca8b30f5822..f8ffc8be2de 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -4484,7 +4484,7 @@ and TcTyparDecl (cenv: cenv) env synTyparDecl = let hasMeasureAttr = HasFSharpAttribute g g.attrib_MeasureAttribute attrs let hasEqDepAttr = HasFSharpAttribute g g.attrib_EqualityConditionalOnAttribute attrs let hasCompDepAttr = HasFSharpAttribute g g.attrib_ComparisonConditionalOnAttribute attrs - let attrs = attrs |> List.filter (IsMatchingFSharpAttribute g g.attrib_MeasureAttribute >> not) + let attrs = attrs |> filterOutWellKnownAttribs g WellKnownEntityAttributes.MeasureAttribute WellKnownValAttributes.None let kind = if hasMeasureAttr then TyparKind.Measure else TyparKind.Type let tp = Construct.NewTypar (kind, TyparRigidity.WarnIfNotRigid, synTypar, false, TyparDynamicReq.Yes, attrs, hasEqDepAttr, hasCompDepAttr) diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 52fe1703f2e..b5ea8a23dbe 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -96,7 +96,7 @@ let ActivePatternElemsOfValRef g (vref: ValRef) = let hasStructAttribute() = vref.Attribs |> List.exists (function - | Attrib(targetsOpt = Some(System.AttributeTargets.ReturnValue)) as a -> IsMatchingFSharpAttribute g g.attrib_StructAttribute a + | Attrib(targetsOpt = Some(System.AttributeTargets.ReturnValue)) as a -> classifyValAttrib g a &&& WellKnownValAttributes.StructAttribute <> WellKnownValAttributes.None | _ -> false) if isValueOptionTy g apReturnTy || hasStructAttribute() then ActivePatternReturnKind.StructTypeWrapper elif isBoolTy g apReturnTy then ActivePatternReturnKind.Boolean diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index 085aaccd3f9..62c95f6bbf7 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -672,20 +672,28 @@ module PrintTypes = let attrsL = [ if denv.showAttributes then - // Don't display DllImport and other attributes in generated signatures - let attrs = attrs |> List.filter (IsMatchingFSharpAttributeOpt denv.g denv.g.attrib_DllImportAttribute >> not) - let attrs = attrs |> List.filter (IsMatchingFSharpAttributeOpt denv.g denv.g.attrib_ContextStaticAttribute >> not) - let attrs = attrs |> List.filter (IsMatchingFSharpAttributeOpt denv.g denv.g.attrib_ThreadStaticAttribute >> not) - let attrs = attrs |> List.filter (IsMatchingFSharpAttribute denv.g denv.g.attrib_EntryPointAttribute >> not) - let attrs = attrs |> List.filter (IsMatchingFSharpAttributeOpt denv.g denv.g.attrib_MarshalAsAttribute >> not) - let attrs = attrs |> List.filter (IsMatchingFSharpAttribute denv.g denv.g.attrib_ReflectedDefinitionAttribute >> not) - let attrs = attrs |> List.filter (IsMatchingFSharpAttribute denv.g denv.g.attrib_StructLayoutAttribute >> not) - let attrs = attrs |> List.filter (IsMatchingFSharpAttribute denv.g denv.g.attrib_AutoSerializableAttribute >> not) - let attrs = attrs |> List.filter (IsMatchingFSharpAttribute denv.g denv.g.attrib_LiteralAttribute >> not) - let attrs = attrs |> List.filter (IsMatchingFSharpAttribute denv.g denv.g.attrib_MeasureAttribute >> not) - let attrs = attrs |> List.filter (IsMatchingFSharpAttribute denv.g denv.g.attrib_StructAttribute >> not) - let attrs = attrs |> List.filter (IsMatchingFSharpAttribute denv.g denv.g.attrib_ClassAttribute >> not) - let attrs = attrs |> List.filter (IsMatchingFSharpAttribute denv.g denv.g.attrib_InterfaceAttribute >> not) + // Don't display well-known attributes in generated signatures + let hiddenEntityMask = + WellKnownEntityAttributes.StructLayoutAttribute + ||| WellKnownEntityAttributes.AutoSerializableAttribute_True + ||| WellKnownEntityAttributes.AutoSerializableAttribute_False + ||| WellKnownEntityAttributes.MeasureAttribute + ||| WellKnownEntityAttributes.StructAttribute + ||| WellKnownEntityAttributes.ClassAttribute + ||| WellKnownEntityAttributes.InterfaceAttribute + ||| WellKnownEntityAttributes.ReflectedDefinitionAttribute + + let hiddenValMask = + WellKnownValAttributes.DllImportAttribute + ||| WellKnownValAttributes.ContextStaticAttribute + ||| WellKnownValAttributes.ThreadStaticAttribute + ||| WellKnownValAttributes.EntryPointAttribute + ||| WellKnownValAttributes.MarshalAsAttribute + ||| WellKnownValAttributes.ReflectedDefinitionAttribute_True + ||| WellKnownValAttributes.ReflectedDefinitionAttribute_False + ||| WellKnownValAttributes.LiteralAttribute + + let attrs = filterOutWellKnownAttribs denv.g hiddenEntityMask hiddenValMask attrs for attr in attrs do layoutAttrib denv attr @@ -1092,7 +1100,7 @@ module PrintTypes = let idL = ConvertValLogicalNameToDisplayLayout false (tagParameter >> rightL) id.idText let attrsLayout = argInfo.Attribs.AsList() - |> List.filter (fun a -> not (IsMatchingFSharpAttribute g g.attrib_OptionalArgumentAttribute a)) + |> filterOutWellKnownAttribs g WellKnownEntityAttributes.None WellKnownValAttributes.OptionalArgumentAttribute |> layoutAttribsOneline denv attrsLayout ^^ diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index 72510543261..03e371bcd7f 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -291,7 +291,7 @@ let CrackParamAttribsInfo g (ty: TType, argInfo: ArgReprInfo) = if isCalleeSideOptArg then CalleeSide elif isCallerSideOptArg then - let defaultParameterValueAttribute = TryFindFSharpAttributeOpt g g.attrib_DefaultParameterValueAttribute attribs + let defaultParameterValueAttribute = tryFindValAttribByFlag g WellKnownValAttributes.DefaultParameterValueAttribute attribs match defaultParameterValueAttribute with | None -> // Do a type-directed analysis of the type to determine the default value to pass. diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 277298ea26e..be470a2fe27 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -8811,9 +8811,9 @@ and GenMarshal cenv attribs = | IlReflectBackend -> attribs | IlWriteBackend -> attribs - |> List.filter (IsMatchingFSharpAttributeOpt g g.attrib_MarshalAsAttribute >> not) + |> filterOutWellKnownAttribs g WellKnownEntityAttributes.None WellKnownValAttributes.MarshalAsAttribute - match TryFindFSharpAttributeOpt g g.attrib_MarshalAsAttribute attribs with + match tryFindValAttribByFlag g WellKnownValAttributes.MarshalAsAttribute attribs with | Some(Attrib(_, _, [ AttribInt32Arg unmanagedType ], namedArgs, _, _, m)) -> let decoder = AttributeDecoder namedArgs @@ -8959,16 +8959,19 @@ and GenParamAttribs cenv paramTy attribs = <> WellKnownValAttributes.None let defaultValue = - TryFindFSharpAttributeOpt g g.attrib_DefaultParameterValueAttribute attribs + tryFindValAttribByFlag g WellKnownValAttributes.DefaultParameterValueAttribute attribs |> Option.bind OptionalArgInfo.FieldInitForDefaultParameterValueAttrib // Return the filtered attributes. Do not generate In, Out, Optional or DefaultParameterValue attributes // as custom attributes in the code - they are implicit from the IL bits for these let attribs = attribs - |> List.filter (IsMatchingFSharpAttribute g g.attrib_InAttribute >> not) - |> List.filter (IsMatchingFSharpAttribute g g.attrib_OutAttribute >> not) - |> List.filter (IsMatchingFSharpAttributeOpt g g.attrib_OptionalAttribute >> not) - |> List.filter (IsMatchingFSharpAttributeOpt g g.attrib_DefaultParameterValueAttribute >> not) + |> filterOutWellKnownAttribs + g + WellKnownEntityAttributes.None + (WellKnownValAttributes.InAttribute + ||| WellKnownValAttributes.OutAttribute + ||| WellKnownValAttributes.OptionalAttribute + ||| WellKnownValAttributes.DefaultParameterValueAttribute) let Marshal, attribs = GenMarshal cenv attribs inFlag, outFlag, optionalFlag, defaultValue, Marshal, attribs @@ -9163,8 +9166,11 @@ and ComputeMethodImplAttribs cenv (_v: Val) attrs = // (See ECMA 335, Partition II, section 23.1.11 - Flags for methods [MethodImplAttributes]) let attrs = attrs - |> List.filter (IsMatchingFSharpAttribute g g.attrib_MethodImplAttribute >> not) - |> List.filter (IsMatchingFSharpAttributeOpt g g.attrib_PreserveSigAttribute >> not) + |> filterOutWellKnownAttribs + g + WellKnownEntityAttributes.None + (WellKnownValAttributes.MethodImplAttribute + ||| WellKnownValAttributes.PreserveSigAttribute) let hasPreserveSigImplFlag = ((implflags &&& 0x80) <> 0x0) || hasPreserveSigAttr let hasSynchronizedImplFlag = (implflags &&& 0x20) <> 0x0 @@ -9293,7 +9299,7 @@ and GenMethodForBinding // Now generate the code. let hasPreserveSigNamedArg, ilMethodBody, hasDllImport = - match TryFindFSharpAttributeOpt g g.attrib_DllImportAttribute v.Attribs with + match tryFindValAttribByFlag g WellKnownValAttributes.DllImportAttribute v.Attribs with | Some(Attrib(_, _, [ AttribStringArg dll ], namedArgs, _, _, m)) -> if not (isNil methLambdaTypars) then error (Error(FSComp.SR.ilSignatureForExternalFunctionContainsTypeParameters (), m)) @@ -9342,17 +9348,17 @@ and GenMethodForBinding // Do not generate DllImport attributes into the code - they are implicit from the P/Invoke let attrs = v.Attribs - |> List.filter (IsMatchingFSharpAttributeOpt g g.attrib_DllImportAttribute >> not) - |> List.filter (IsMatchingFSharpAttribute g g.attrib_CompiledNameAttribute >> not) + |> filterOutWellKnownAttribs + g + WellKnownEntityAttributes.None + (WellKnownValAttributes.DllImportAttribute + ||| WellKnownValAttributes.CompiledNameAttribute) let attrsAppliedToGetterOrSetter, attrs = List.partition (fun (Attrib(_, _, _, _, isAppliedToGetterOrSetter, _, _)) -> isAppliedToGetterOrSetter) attrs let sourceNameAttribs, compiledName = - match - v.Attribs - |> List.tryFind (IsMatchingFSharpAttribute g g.attrib_CompiledNameAttribute) - with + match tryFindValAttribByFlag g WellKnownValAttributes.CompiledNameAttribute v.Attribs with | Some(Attrib(_, _, [ AttribStringArg b ], _, _, _, _)) -> [ mkCompilationSourceNameAttr g v.LogicalName ], Some b | _ -> [], None @@ -11019,7 +11025,9 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option // DebugDisplayAttribute gets copied to the subtypes generated as part of DU compilation let debugDisplayAttrs, normalAttrs = tycon.Attribs - |> List.partition (IsMatchingFSharpAttribute g g.attrib_DebuggerDisplayAttribute) + |> List.partition (fun a -> + classifyEntityAttrib g a &&& WellKnownEntityAttributes.DebuggerDisplayAttribute + <> WellKnownEntityAttributes.None) let securityAttrs, normalAttrs = normalAttrs @@ -11055,7 +11063,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option yield! defaultMemberAttrs yield! normalAttrs - |> List.filter (IsMatchingFSharpAttribute g g.attrib_StructLayoutAttribute >> not) + |> filterOutWellKnownAttribs g WellKnownEntityAttributes.StructLayoutAttribute WellKnownValAttributes.None |> GenAttrs cenv eenv yield! ilDebugDisplayAttributes ] @@ -11157,10 +11165,11 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option let fattribs = attribs - // Do not generate FieldOffset as a true CLI custom attribute, since it is implied by other corresponding CLI metadata - |> List.filter (IsMatchingFSharpAttribute g g.attrib_FieldOffsetAttribute >> not) - // Do not generate NonSerialized as a true CLI custom attribute, since it is implied by other corresponding CLI metadata - |> List.filter (IsMatchingFSharpAttributeOpt g g.attrib_NonSerializedAttribute >> not) + |> filterOutWellKnownAttribs + g + WellKnownEntityAttributes.None + (WellKnownValAttributes.FieldOffsetAttribute + ||| WellKnownValAttributes.NonSerializedAttribute) let ilFieldMarshal, fattribs = GenMarshal cenv fattribs diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 9eed5f7e2e4..e270d8597f3 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3728,6 +3728,7 @@ let classifyEntityAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownEntityAttrib | [| "System"; "Diagnostics"; name |] -> match name with + | "DebuggerDisplayAttribute" -> flag <- WellKnownEntityAttributes.DebuggerDisplayAttribute | "DebuggerTypeProxyAttribute" -> flag <- WellKnownEntityAttributes.DebuggerTypeProxyAttribute | _ -> () @@ -3956,6 +3957,7 @@ let classifyValAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownValAttributes = | "DllImportAttribute" -> flag <- WellKnownValAttributes.DllImportAttribute | "InAttribute" -> flag <- WellKnownValAttributes.InAttribute | "OutAttribute" -> flag <- WellKnownValAttributes.OutAttribute + | "MarshalAsAttribute" -> flag <- WellKnownValAttributes.MarshalAsAttribute | "DefaultParameterValueAttribute" -> flag <- WellKnownValAttributes.DefaultParameterValueAttribute | "OptionalAttribute" -> flag <- WellKnownValAttributes.OptionalAttribute | "PreserveSigAttribute" -> flag <- WellKnownValAttributes.PreserveSigAttribute @@ -4040,6 +4042,21 @@ let (|ValAttribString|_|) (g: TcGlobals) (flag: WellKnownValAttributes) (attribs let attribsHaveValFlag g (flag: WellKnownValAttributes) (attribs: Attribs) = attribsHaveFlag classifyValAttrib WellKnownValAttributes.None g flag attribs +/// Filter out well-known attributes from a list. Single-pass using classify functions. +/// Attributes matching ANY set bit in entityMask or valMask are removed. +let filterOutWellKnownAttribs + (g: TcGlobals) + (entityMask: WellKnownEntityAttributes) + (valMask: WellKnownValAttributes) + (attribs: Attribs) + = + attribs + |> List.filter (fun attrib -> + (entityMask = WellKnownEntityAttributes.None + || classifyEntityAttrib g attrib &&& entityMask = WellKnownEntityAttributes.None) + && (valMask = WellKnownValAttributes.None + || classifyValAttrib g attrib &&& valMask = WellKnownValAttributes.None)) + /// Check if an ArgReprInfo has a specific well-known attribute, computing and caching flags if needed. let ArgReprInfoHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownValAttributes) (argInfo: ArgReprInfo) : bool = let wa = argInfo.Attribs @@ -12271,8 +12288,7 @@ let (|EmptyModuleOrNamespaces|_|) (moduleOrNamespaceContents: ModuleOrNamespaceC | _ -> ValueNone let tryFindExtensionAttribute (g: TcGlobals) (attribs: Attrib list): Attrib option = - attribs - |> List.tryFind (IsMatchingFSharpAttribute g g.attrib_ExtensionAttribute) + tryFindEntityAttribByFlag g WellKnownEntityAttributes.ExtensionAttribute attribs let tryAddExtensionAttributeIfNotAlreadyPresentForModule (g: TcGlobals) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 0c9bc871c62..78783032930 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2396,9 +2396,22 @@ type ILFieldDef with /// Compute well-known attribute flags for an Entity's Attrib list. val computeEntityWellKnownFlags: g: TcGlobals -> attribs: Attribs -> WellKnownEntityAttributes +/// Classify a single entity-level attrib to its well-known flag (or None). +val classifyEntityAttrib: g: TcGlobals -> attrib: Attrib -> WellKnownEntityAttributes + +/// Classify a single val-level attrib to its well-known flag (or None). +val classifyValAttrib: g: TcGlobals -> attrib: Attrib -> WellKnownValAttributes + /// Check if an Entity has a specific well-known attribute, computing and caching flags if needed. val attribsHaveEntityFlag: g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> bool +val filterOutWellKnownAttribs: + g: TcGlobals -> + entityMask: WellKnownEntityAttributes -> + valMask: WellKnownValAttributes -> + attribs: Attribs -> + Attribs + val tryFindEntityAttribByFlag: g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> Attrib option [] @@ -2417,6 +2430,8 @@ val (|AssemblyAttribString|_|): g: TcGlobals -> flag: WellKnownAssemblyAttribute val attribsHaveValFlag: g: TcGlobals -> flag: WellKnownValAttributes -> attribs: Attribs -> bool +val tryFindValAttribByFlag: g: TcGlobals -> flag: WellKnownValAttributes -> attribs: Attribs -> Attrib option + [] val (|ValAttrib|_|): g: TcGlobals -> flag: WellKnownValAttributes -> attribs: Attribs -> Attrib voption diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fs b/src/Compiler/TypedTree/WellKnownAttribs.fs index ccc7e6e2fc1..c6efe085814 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fs +++ b/src/Compiler/TypedTree/WellKnownAttribs.fs @@ -56,6 +56,7 @@ type internal WellKnownEntityAttributes = | UnverifiableAttribute = (1uL <<< 45) | EditorBrowsableAttribute = (1uL <<< 46) | CompiledNameAttribute = (1uL <<< 47) + | DebuggerDisplayAttribute = (1uL <<< 48) | NotComputed = (1uL <<< 63) /// Flags enum for well-known assembly-level attributes. @@ -111,6 +112,7 @@ type internal WellKnownValAttributes = | FieldOffsetAttribute = (1uL <<< 34) | CompiledNameAttribute = (1uL <<< 35) | WarnOnWithoutNullArgumentAttribute = (1uL <<< 36) + | MarshalAsAttribute = (1uL <<< 37) | NotComputed = (1uL <<< 63) /// Generic wrapper for an item list together with cached well-known attribute flags. diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fsi b/src/Compiler/TypedTree/WellKnownAttribs.fsi index 62b2e4912ad..8a6b05e666f 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fsi +++ b/src/Compiler/TypedTree/WellKnownAttribs.fsi @@ -55,6 +55,7 @@ type internal WellKnownEntityAttributes = | UnverifiableAttribute = (1uL <<< 45) | EditorBrowsableAttribute = (1uL <<< 46) | CompiledNameAttribute = (1uL <<< 47) + | DebuggerDisplayAttribute = (1uL <<< 48) | NotComputed = (1uL <<< 63) /// Flags enum for well-known assembly-level attributes. @@ -108,6 +109,7 @@ type internal WellKnownValAttributes = | FieldOffsetAttribute = (1uL <<< 34) | CompiledNameAttribute = (1uL <<< 35) | WarnOnWithoutNullArgumentAttribute = (1uL <<< 36) + | MarshalAsAttribute = (1uL <<< 37) | NotComputed = (1uL <<< 63) /// Generic wrapper for an item list together with cached well-known attribute flags. From 3ba491b7b24871d5cd40c35d4b995cc3333e9bef Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Sun, 1 Mar 2026 19:42:11 +0100 Subject: [PATCH 49/71] Filter chain optimization + delete dead helpers and 18 g.attrib_ members MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Major changes: - filterOutWellKnownAttribs: single-pass filter using classify functions replaces 30+ serial IsMatchingFSharpAttribute filter chains - NicePrint.fs: 13 serial O(N) filters → 1 filterOutWellKnownAttribs call - IlxGen.fs: 12 filter sites migrated to filterOutWellKnownAttribs - Data extraction: TryFindFSharpAttributeOpt callers migrated to ValAttrib APs Dead code removed: - TryFindFSharpAttributeOpt, IsMatchingFSharpAttributeOpt (zero callers) - 18 g.attrib_ TcGlobals members (zero callers) g.attrib_ members: 59 → 41 Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TcGlobals.fs | 25 +++++++------------------ src/Compiler/TypedTree/TcGlobals.fsi | 18 ------------------ src/Compiler/TypedTree/TypedTreeOps.fs | 3 +-- src/Compiler/TypedTree/TypedTreeOps.fsi | 4 ---- 4 files changed, 8 insertions(+), 42 deletions(-) diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 9766f2cb7b7..0cd443c34fc 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -1478,37 +1478,26 @@ type TcGlobals( member val attrib_SystemObsolete = findSysAttrib "System.ObsoleteAttribute" member val attrib_IsByRefLikeAttribute_opt = tryFindSysAttrib "System.Runtime.CompilerServices.IsByRefLikeAttribute" member val attrib_DllImportAttribute = tryFindSysAttrib "System.Runtime.InteropServices.DllImportAttribute" - member val attrib_StructLayoutAttribute = findSysAttrib "System.Runtime.InteropServices.StructLayoutAttribute" + member val attrib_TypeForwardedToAttribute = findSysAttrib "System.Runtime.CompilerServices.TypeForwardedToAttribute" - member val attrib_FieldOffsetAttribute = findSysAttrib "System.Runtime.InteropServices.FieldOffsetAttribute" - member val attrib_MarshalAsAttribute = tryFindSysAttrib "System.Runtime.InteropServices.MarshalAsAttribute" + member val attrib_InAttribute = findSysAttrib "System.Runtime.InteropServices.InAttribute" - member val attrib_OutAttribute = findSysAttrib "System.Runtime.InteropServices.OutAttribute" - member val attrib_OptionalAttribute = tryFindSysAttrib "System.Runtime.InteropServices.OptionalAttribute" - member val attrib_DefaultParameterValueAttribute = tryFindSysAttrib "System.Runtime.InteropServices.DefaultParameterValueAttribute" - member val attrib_ThreadStaticAttribute = tryFindSysAttrib "System.ThreadStaticAttribute" + member val attrib_NoEagerConstraintApplicationAttribute = mk_MFCompilerServices_attrib "NoEagerConstraintApplicationAttribute" - member val attrib_ContextStaticAttribute = tryFindSysAttrib "System.ContextStaticAttribute" + member val attrib_FlagsAttribute = findSysAttrib "System.FlagsAttribute" member val attrib_DefaultMemberAttribute = findSysAttrib "System.Reflection.DefaultMemberAttribute" - member val attrib_DebuggerDisplayAttribute = findSysAttrib "System.Diagnostics.DebuggerDisplayAttribute" - member val attrib_PreserveSigAttribute = tryFindSysAttrib "System.Runtime.InteropServices.PreserveSigAttribute" - member val attrib_MethodImplAttribute = findSysAttrib "System.Runtime.CompilerServices.MethodImplAttribute" + member val attrib_ExtensionAttribute = findSysAttrib "System.Runtime.CompilerServices.ExtensionAttribute" member val attrib_DecimalConstantAttribute = findSysAttrib "System.Runtime.CompilerServices.DecimalConstantAttribute" member val attribs_Unsupported = v_attribs_Unsupported member val attrib_CustomOperationAttribute = mk_MFCore_attrib "CustomOperationAttribute" - member val attrib_NonSerializedAttribute = tryFindSysAttrib "System.NonSerializedAttribute" - member val attrib_AutoSerializableAttribute = mk_MFCore_attrib "AutoSerializableAttribute" - member val attrib_EntryPointAttribute = mk_MFCore_attrib "EntryPointAttribute" - member val attrib_LiteralAttribute = mk_MFCore_attrib "LiteralAttribute" member val attrib_ConditionalAttribute = findSysAttrib "System.Diagnostics.ConditionalAttribute" - member val attrib_OptionalArgumentAttribute = mk_MFCore_attrib "OptionalArgumentAttribute" + member val attrib_DefaultValueAttribute = mk_MFCore_attrib "DefaultValueAttribute" - member val attrib_ClassAttribute = mk_MFCore_attrib "ClassAttribute" - member val attrib_InterfaceAttribute = mk_MFCore_attrib "InterfaceAttribute" + member val attrib_StructAttribute = mk_MFCore_attrib "StructAttribute" member val attrib_ReflectedDefinitionAttribute = mk_MFCore_attrib "ReflectedDefinitionAttribute" member val attrib_CompiledNameAttribute = mk_MFCore_attrib "CompiledNameAttribute" diff --git a/src/Compiler/TypedTree/TcGlobals.fsi b/src/Compiler/TypedTree/TcGlobals.fsi index 1ba2e0a7fba..74059afb388 100644 --- a/src/Compiler/TypedTree/TcGlobals.fsi +++ b/src/Compiler/TypedTree/TcGlobals.fsi @@ -313,14 +313,12 @@ type internal TcGlobals = member attrib_AutoOpenAttribute: BuiltinAttribInfo - member attrib_AutoSerializableAttribute: BuiltinAttribInfo - member attrib_ClassAttribute: BuiltinAttribInfo @@ -337,19 +335,16 @@ type internal TcGlobals = member attrib_ConditionalAttribute: BuiltinAttribInfo - member attrib_ContextStaticAttribute: BuiltinAttribInfo option member attrib_CustomOperationAttribute: BuiltinAttribInfo - member attrib_DebuggerDisplayAttribute: BuiltinAttribInfo member attrib_DefaultMemberAttribute: BuiltinAttribInfo - member attrib_DefaultParameterValueAttribute: BuiltinAttribInfo option member attrib_DefaultValueAttribute: BuiltinAttribInfo @@ -357,13 +352,11 @@ type internal TcGlobals = member attrib_DynamicDependencyAttribute: BuiltinAttribInfo - member attrib_EntryPointAttribute: BuiltinAttribInfo member attrib_EqualityConditionalOnAttribute: BuiltinAttribInfo member attrib_ExtensionAttribute: BuiltinAttribInfo - member attrib_FieldOffsetAttribute: BuiltinAttribInfo member attrib_FlagsAttribute: BuiltinAttribInfo @@ -373,22 +366,18 @@ type internal TcGlobals = member attrib_InAttribute: BuiltinAttribInfo - member attrib_InterfaceAttribute: BuiltinAttribInfo member attrib_IsReadOnlyAttribute: BuiltinAttribInfo member attrib_IsUnmanagedAttribute: BuiltinAttribInfo - member attrib_LiteralAttribute: BuiltinAttribInfo - member attrib_MarshalAsAttribute: BuiltinAttribInfo option member attrib_MeasureAttribute: BuiltinAttribInfo member attrib_MemberNotNullWhenAttribute: BuiltinAttribInfo - member attrib_MethodImplAttribute: BuiltinAttribInfo @@ -396,7 +385,6 @@ type internal TcGlobals = member attrib_NoEagerConstraintApplicationAttribute: BuiltinAttribInfo - member attrib_NonSerializedAttribute: BuiltinAttribInfo option member attrib_NullableAttribute: BuiltinAttribInfo @@ -406,15 +394,11 @@ type internal TcGlobals = member attrib_NullableContextAttribute_opt: BuiltinAttribInfo option - member attrib_OptionalArgumentAttribute: BuiltinAttribInfo - member attrib_OptionalAttribute: BuiltinAttribInfo option - member attrib_OutAttribute: BuiltinAttribInfo member attrib_ParamArrayAttribute: BuiltinAttribInfo - member attrib_PreserveSigAttribute: BuiltinAttribInfo option @@ -440,7 +424,6 @@ type internal TcGlobals = member attrib_StructAttribute: BuiltinAttribInfo - member attrib_StructLayoutAttribute: BuiltinAttribInfo @@ -448,7 +431,6 @@ type internal TcGlobals = member attrib_IsByRefLikeAttribute_opt: BuiltinAttribInfo option - member attrib_ThreadStaticAttribute: BuiltinAttribInfo option member attrib_TypeForwardedToAttribute: BuiltinAttribInfo diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index e270d8597f3..51b99347589 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3548,8 +3548,7 @@ let TryDecodeILAttribute tref (attrs: ILAttributes) = let IsMatchingFSharpAttribute g (AttribInfo(_, tcref)) (Attrib(tcref2, _, _, _, _, _, _)) = tyconRefEq g tcref tcref2 let HasFSharpAttribute g tref attrs = List.exists (IsMatchingFSharpAttribute g tref) attrs let TryFindFSharpAttribute g tref attrs = List.tryFind (IsMatchingFSharpAttribute g tref) attrs -let TryFindFSharpAttributeOpt g tref attrs = match tref with None -> None | Some tref -> List.tryFind (IsMatchingFSharpAttribute g tref) attrs -let IsMatchingFSharpAttributeOpt g attrOpt (Attrib(tcref2, _, _, _, _, _, _)) = match attrOpt with Some (AttribInfo(_, tcref)) -> tyconRefEq g tcref tcref2 | _ -> false + [] let (|ExtractAttribNamedArg|_|) nm args = diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 78783032930..bdaf8f0766e 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2464,14 +2464,10 @@ val EntityTryGetBoolAttribute: val IsMatchingFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attrib -> bool -val IsMatchingFSharpAttributeOpt: TcGlobals -> BuiltinAttribInfo option -> Attrib -> bool - val HasFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> bool val TryFindFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> Attrib option -val TryFindFSharpAttributeOpt: TcGlobals -> BuiltinAttribInfo option -> Attribs -> Attrib option - /// Try to find a specific attribute on a type definition, where the attribute accepts a string argument. /// /// This is used to detect the 'DefaultMemberAttribute' and 'ConditionalAttribute' attributes (on type definitions) From 93acbd412ea62099e5b7b5538ae78dec22660177 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Sun, 1 Mar 2026 20:31:14 +0100 Subject: [PATCH 50/71] Add IL-level classifyILAttrib + (|ILAttribDecoded|_|) AP, migrate 9 TryDecodeILAttribute sites MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Factor computeILWellKnownFlags into classifyILAttrib (per-attrib) + fold. Add tryFindILAttribByFlag and (|ILAttribDecoded|_|) active pattern for enum-powered IL attribute data extraction. New WellKnownILAttributes flags: CompilerFeatureRequired, Experimental, RequiredMember, NullableContext, AttributeUsage. Migrated 9 TryDecodeILAttribute callsites: - AttributeChecking.fs: CompilerFeatureRequired, Experimental, Obsolete(×3), IsByRefLike - import.fs: NullableAttribute, NullableContextAttribute - infos.fs: ReflectedDefinition Also migrated TryFindILAttribute callers: - CheckExpressions.fs: SetsRequiredMembersAttribute → tryFindILAttribByFlag - infos.fs: RequiredMemberAttribute → tryFindILAttribByFlag Deleted 6 g.attrib_ members (zero callers): NullableAttribute_opt, NullableContextAttribute_opt, CompilerFeatureRequiredAttribute, SetsRequiredMembersAttribute, RequiredMemberAttribute, IlExperimentalAttribute. g.attrib_ members: 41 → 35 Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/AbstractIL/il.fs | 5 + src/Compiler/AbstractIL/il.fsi | 5 + src/Compiler/Checking/AttributeChecking.fs | 75 +++++------ .../Checking/Expressions/CheckExpressions.fs | 29 +++-- src/Compiler/Checking/import.fs | 14 +- src/Compiler/Checking/infos.fs | 10 +- src/Compiler/TypedTree/TcGlobals.fs | 5 - src/Compiler/TypedTree/TcGlobals.fsi | 15 +-- src/Compiler/TypedTree/TypedTreeOps.fs | 121 +++++++++--------- src/Compiler/TypedTree/TypedTreeOps.fsi | 8 ++ 10 files changed, 145 insertions(+), 142 deletions(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index 98d9a50e1ec..903a3caeee3 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -1252,6 +1252,11 @@ type WellKnownILAttributes = | NoEagerConstraintApplicationAttribute = (1u <<< 17) | DefaultMemberAttribute = (1u <<< 18) | ObsoleteAttribute = (1u <<< 19) + | CompilerFeatureRequiredAttribute = (1u <<< 20) + | ExperimentalAttribute = (1u <<< 21) + | RequiredMemberAttribute = (1u <<< 22) + | NullableContextAttribute = (1u <<< 23) + | AttributeUsageAttribute = (1u <<< 24) | NotComputed = (1u <<< 31) type internal ILAttributesStoredRepr = diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index 26894311263..1ef4c96b297 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -901,6 +901,11 @@ type WellKnownILAttributes = | NoEagerConstraintApplicationAttribute = (1u <<< 17) | DefaultMemberAttribute = (1u <<< 18) | ObsoleteAttribute = (1u <<< 19) + | CompilerFeatureRequiredAttribute = (1u <<< 20) + | ExperimentalAttribute = (1u <<< 21) + | RequiredMemberAttribute = (1u <<< 22) + | NullableContextAttribute = (1u <<< 23) + | AttributeUsageAttribute = (1u <<< 24) | NotComputed = (1u <<< 31) /// Represents the efficiency-oriented storage of ILAttributes in another item. diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index 266df5fe235..3dc9e33c836 100755 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -231,13 +231,12 @@ let MethInfoHasAttribute g m attribSpec minfo = (fun _ -> Some ()) |> Option.isSome -let private CheckCompilerFeatureRequiredAttribute (g: TcGlobals) cattrs msg m = +let private CheckCompilerFeatureRequiredAttribute (_g: TcGlobals) cattrs msg m = // In some cases C# will generate both ObsoleteAttribute and CompilerFeatureRequiredAttribute. // Specifically, when default constructor is generated for class with any required members in them. // ObsoleteAttribute should be ignored if CompilerFeatureRequiredAttribute is present, and its name is "RequiredMembers". - let (AttribInfo(tref,_)) = g.attrib_CompilerFeatureRequiredAttribute - match TryDecodeILAttribute tref cattrs with - | Some([ILAttribElem.String (Some featureName) ], _) when featureName = "RequiredMembers" -> + match cattrs with + | ILAttribDecoded WellKnownILAttributes.CompilerFeatureRequiredAttribute ([ILAttribElem.String (Some featureName) ], _) when featureName = "RequiredMembers" -> CompleteD | _ -> ErrorD (ObsoleteDiagnostic(true, None, msg, None, m)) @@ -252,15 +251,14 @@ let private extractILAttributeInfo namedArgs = let urlFormat = extractILAttribValueFrom "UrlFormat" namedArgs (diagnosticId, urlFormat) -let private CheckILExperimentalAttributes (g: TcGlobals) cattrs m = - let (AttribInfo(tref,_)) = g.attrib_IlExperimentalAttribute - match TryDecodeILAttribute tref cattrs with +let private CheckILExperimentalAttributes (_g: TcGlobals) cattrs m = + match cattrs with // [Experimental("DiagnosticId")] // [Experimental(diagnosticId: "DiagnosticId")] // [Experimental("DiagnosticId", UrlFormat = "UrlFormat")] // [Experimental(diagnosticId = "DiagnosticId", UrlFormat = "UrlFormat")] // Constructors deciding on DiagnosticId and UrlFormat properties. - | Some ([ attribElement ], namedArgs) -> + | ILAttribDecoded WellKnownILAttributes.ExperimentalAttribute ([ attribElement ], namedArgs) -> let diagnosticId = match attribElement with | ILAttribElem.String (Some msg) -> Some msg @@ -272,15 +270,13 @@ let private CheckILExperimentalAttributes (g: TcGlobals) cattrs m = WarnD(Experimental(message, diagnosticId, urlFormat, m)) // Empty constructor or only UrlFormat property are not allowed. - | Some _ - | None -> CompleteD + | _ -> CompleteD let private CheckILObsoleteAttributes (g: TcGlobals) isByrefLikeTyconRef cattrs m = if isByrefLikeTyconRef then CompleteD else - let (AttribInfo(tref,_)) = g.attrib_SystemObsolete - match TryDecodeILAttribute tref cattrs with + match cattrs with // [Obsolete] // [Obsolete("Message")] // [Obsolete("Message", true)] @@ -291,30 +287,32 @@ let private CheckILObsoleteAttributes (g: TcGlobals) isByrefLikeTyconRef cattrs // [Obsolete("Message", true, DiagnosticId = "DiagnosticId")] // [Obsolete("Message", true, DiagnosticId = "DiagnosticId", UrlFormat = "UrlFormat")] // Constructors deciding on IsError and Message properties. - | Some ([ attribElement ], namedArgs) -> - let diagnosticId, urlFormat = extractILAttributeInfo namedArgs - let msg = - match attribElement with - | ILAttribElem.String (Some msg) -> Some msg - | ILAttribElem.String None - | _ -> None - - WarnD (ObsoleteDiagnostic(false, diagnosticId, msg, urlFormat, m)) - | Some ([ILAttribElem.String msg; ILAttribElem.Bool isError ], namedArgs) -> - let diagnosticId, urlFormat = extractILAttributeInfo namedArgs - if isError then - if g.langVersion.SupportsFeature(LanguageFeature.RequiredPropertiesSupport) then - CheckCompilerFeatureRequiredAttribute g cattrs msg m - else - ErrorD (ObsoleteDiagnostic(true, diagnosticId, msg, urlFormat, m)) - else + | ILAttribDecoded WellKnownILAttributes.ObsoleteAttribute decoded -> + match decoded with + | ([ attribElement ], namedArgs) -> + let diagnosticId, urlFormat = extractILAttributeInfo namedArgs + let msg = + match attribElement with + | ILAttribElem.String (Some msg) -> Some msg + | ILAttribElem.String None + | _ -> None + WarnD (ObsoleteDiagnostic(false, diagnosticId, msg, urlFormat, m)) - // Only DiagnosticId, UrlFormat - | Some (_, namedArgs) -> - let diagnosticId, urlFormat = extractILAttributeInfo namedArgs - WarnD(ObsoleteDiagnostic(false, diagnosticId, None, urlFormat, m)) + | ([ILAttribElem.String msg; ILAttribElem.Bool isError ], namedArgs) -> + let diagnosticId, urlFormat = extractILAttributeInfo namedArgs + if isError then + if g.langVersion.SupportsFeature(LanguageFeature.RequiredPropertiesSupport) then + CheckCompilerFeatureRequiredAttribute g cattrs msg m + else + ErrorD (ObsoleteDiagnostic(true, diagnosticId, msg, urlFormat, m)) + else + WarnD (ObsoleteDiagnostic(false, diagnosticId, msg, urlFormat, m)) + // Only DiagnosticId, UrlFormat + | (_, namedArgs) -> + let diagnosticId, urlFormat = extractILAttributeInfo namedArgs + WarnD(ObsoleteDiagnostic(false, diagnosticId, None, urlFormat, m)) // No arguments - | None -> CompleteD + | _ -> CompleteD /// Check IL attributes for Experimental, warnings as data let private CheckILAttributes (g: TcGlobals) isByrefLikeTyconRef cattrs m = @@ -437,13 +435,10 @@ let CheckILAttributesForUnseenStored (g: TcGlobals) (cattrsStored: ILAttributesS /// Indicate if a list of IL attributes contains 'ObsoleteAttribute'. Used to suppress the item in intellisense. let CheckILAttributesForUnseen (g: TcGlobals) cattrs _m = - let (AttribInfo(tref, _)) = g.attrib_SystemObsolete - let hasObsolete = Option.isSome (TryDecodeILAttribute tref cattrs) + ignore g + let hasObsolete = tryFindILAttribByFlag WellKnownILAttributes.ObsoleteAttribute cattrs |> Option.isSome if hasObsolete then - match g.attrib_IsByRefLikeAttribute_opt with - | Some (AttribInfo(isByRefLikeTref, _)) -> - not (Option.isSome (TryDecodeILAttribute isByRefLikeTref cattrs)) - | None -> true + not (tryFindILAttribByFlag WellKnownILAttributes.IsByRefLikeAttribute cattrs |> Option.isSome) else false diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index f8ffc8be2de..93bc4eec737 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -1329,7 +1329,9 @@ let CheckRequiredProperties (g:TcGlobals) (env: TcEnv) (cenv: TcFileState) (minf match minfo with | ILMeth(_, ilMethInfo, _) -> ilMethInfo.RawMetadata.HasWellKnownAttribute(g, WellKnownILAttributes.SetsRequiredMembersAttribute) - | _ -> TryFindILAttribute g.attrib_SetsRequiredMembersAttribute (minfo.GetCustomAttrs()) + | _ -> + tryFindILAttribByFlag WellKnownILAttributes.SetsRequiredMembersAttribute (minfo.GetCustomAttrs()) + |> Option.isSome ) then let requiredProps = @@ -11467,17 +11469,20 @@ and CheckAttributeUsage (g: TcGlobals) (mAttr: range) (tcref: TyconRef) (attrTgt let inheritedDefault = true if tcref.IsILTycon then let tdef = tcref.ILTyconRawMetadata - let tref = g.attrib_AttributeUsageAttribute.TypeRef - - match TryDecodeILAttribute tref tdef.CustomAttrs with - | Some ([ILAttribElem.Int32 validOn ], named) -> - let inherited = - match List.tryPick (function "Inherited", _, _, ILAttribElem.Bool res -> Some res | _ -> None) named with - | None -> inheritedDefault - | Some x -> x - (validOn, inherited) - | Some ([ILAttribElem.Int32 validOn; ILAttribElem.Bool _allowMultiple; ILAttribElem.Bool inherited ], _) -> - (validOn, inherited) + + match tdef.CustomAttrs with + | ILAttribDecoded WellKnownILAttributes.AttributeUsageAttribute decoded -> + match decoded with + | ([ILAttribElem.Int32 validOn ], named) -> + let inherited = + match List.tryPick (function "Inherited", _, _, ILAttribElem.Bool res -> Some res | _ -> None) named with + | None -> inheritedDefault + | Some x -> x + (validOn, inherited) + | ([ILAttribElem.Int32 validOn; ILAttribElem.Bool _allowMultiple; ILAttribElem.Bool inherited ], _) -> + (validOn, inherited) + | _ -> + (validOnDefault, inheritedDefault) | _ -> (validOnDefault, inheritedDefault) else diff --git a/src/Compiler/Checking/import.fs b/src/Compiler/Checking/import.fs index 7a1efe641ba..2c42956800e 100644 --- a/src/Compiler/Checking/import.fs +++ b/src/Compiler/Checking/import.fs @@ -210,18 +210,12 @@ module Nullness = with member this.Read() = match this with| AttributesFromIL(idx,attrs) -> attrs.GetCustomAttrs(idx) member this.GetNullable(g:TcGlobals) = - match g.attrib_NullableAttribute_opt with - | None -> ValueNone - | Some n -> - TryDecodeILAttribute n.TypeRef (this.Read()) - |> tryParseAttributeDataToNullableByteFlags g + tryFindILAttribByFlag WellKnownILAttributes.NullableAttribute (this.Read()) + |> tryParseAttributeDataToNullableByteFlags g member this.GetNullableContext(g:TcGlobals) = - match g.attrib_NullableContextAttribute_opt with - | None -> ValueNone - | Some n -> - TryDecodeILAttribute n.TypeRef (this.Read()) - |> tryParseAttributeDataToNullableByteFlags g + tryFindILAttribByFlag WellKnownILAttributes.NullableContextAttribute (this.Read()) + |> tryParseAttributeDataToNullableByteFlags g [] type NullableContextSource = diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index 03e371bcd7f..f41d3e86952 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -1266,9 +1266,9 @@ type MethInfo = let attrs = p.CustomAttrs let isParamArrayArg = p.CustomAttrsStored.HasWellKnownAttribute(g, WellKnownILAttributes.ParamArrayAttribute) let reflArgInfo = - match TryDecodeILAttribute g.attrib_ReflectedDefinitionAttribute.TypeRef attrs with - | Some ([ILAttribElem.Bool b ], _) -> ReflectedArgInfo.Quote b - | Some _ -> ReflectedArgInfo.Quote false + match attrs with + | ILAttribDecoded WellKnownILAttributes.ReflectedDefinitionAttribute ([ILAttribElem.Bool b ], _) -> ReflectedArgInfo.Quote b + | ILAttribDecoded WellKnownILAttributes.ReflectedDefinitionAttribute _ -> ReflectedArgInfo.Quote false | _ -> ReflectedArgInfo.None let isOutArg = (p.IsOut && not p.IsIn) let isInArg = (p.IsIn && not p.IsOut) @@ -1754,7 +1754,9 @@ type ILPropInfo = (x.HasSetter && x.SetterMethod.IsNewSlot) /// Indicates if the property is required, i.e. has RequiredMemberAttribute applied. - member x.IsRequired = TryFindILAttribute x.TcGlobals.attrib_RequiredMemberAttribute x.RawMetadata.CustomAttrs + member x.IsRequired = + tryFindILAttribByFlag WellKnownILAttributes.RequiredMemberAttribute x.RawMetadata.CustomAttrs + |> Option.isSome /// Get the names and types of the indexer arguments associated with the IL property. /// diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 0cd443c34fc..cc8ce47da6f 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -1468,8 +1468,6 @@ type TcGlobals( 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 attrib_NullableAttribute_opt = tryFindSysAttrib "System.Runtime.CompilerServices.NullableAttribute" - member val attrib_NullableContextAttribute_opt = tryFindSysAttrib "System.Runtime.CompilerServices.NullableContextAttribute" member val attrib_NullableAttribute = findOrEmbedSysPublicType "System.Runtime.CompilerServices.NullableAttribute" member val attrib_NullableContextAttribute = findOrEmbedSysPublicType "System.Runtime.CompilerServices.NullableContextAttribute" member val attrib_MemberNotNullWhenAttribute = findOrEmbedSysPublicType "System.Diagnostics.CodeAnalysis.MemberNotNullWhenAttribute" @@ -1512,9 +1510,6 @@ type TcGlobals( member val attrib_SecurityAttribute = tryFindSysAttrib "System.Security.Permissions.SecurityAttribute" member val attrib_SecurityCriticalAttribute = findSysAttrib "System.Security.SecurityCriticalAttribute" member val attrib_SecuritySafeCriticalAttribute = findSysAttrib "System.Security.SecuritySafeCriticalAttribute" - member val attrib_CompilerFeatureRequiredAttribute = findSysAttrib "System.Runtime.CompilerServices.CompilerFeatureRequiredAttribute" - member val attrib_SetsRequiredMembersAttribute = findSysAttrib "System.Diagnostics.CodeAnalysis.SetsRequiredMembersAttribute" - member val attrib_RequiredMemberAttribute = findSysAttrib "System.Runtime.CompilerServices.RequiredMemberAttribute" member val attrib_IlExperimentalAttribute = findSysAttrib "System.Diagnostics.CodeAnalysis.ExperimentalAttribute" member g.improveType tcref tinst = improveTy tcref tinst diff --git a/src/Compiler/TypedTree/TcGlobals.fsi b/src/Compiler/TypedTree/TcGlobals.fsi index 74059afb388..13227cedf35 100644 --- a/src/Compiler/TypedTree/TcGlobals.fsi +++ b/src/Compiler/TypedTree/TcGlobals.fsi @@ -321,7 +321,6 @@ type internal TcGlobals = - member attrib_ComparisonConditionalOnAttribute: BuiltinAttribInfo member attrib_CompilationArgumentCountsAttribute: BuiltinAttribInfo @@ -331,8 +330,6 @@ type internal TcGlobals = member attrib_CompiledNameAttribute: BuiltinAttribInfo - member attrib_CompilerFeatureRequiredAttribute: BuiltinAttribInfo - member attrib_ConditionalAttribute: BuiltinAttribInfo @@ -388,12 +385,8 @@ type internal TcGlobals = member attrib_NullableAttribute: BuiltinAttribInfo - member attrib_NullableAttribute_opt: BuiltinAttribInfo option - member attrib_NullableContextAttribute: BuiltinAttribInfo - member attrib_NullableContextAttribute_opt: BuiltinAttribInfo option - @@ -405,10 +398,6 @@ type internal TcGlobals = member attrib_ReflectedDefinitionAttribute: BuiltinAttribInfo - member attrib_RequiredMemberAttribute: BuiltinAttribInfo - - - member attrib_SealedAttribute: BuiltinAttribInfo member attrib_SecurityAttribute: BuiltinAttribInfo option @@ -417,9 +406,6 @@ type internal TcGlobals = member attrib_SecuritySafeCriticalAttribute: BuiltinAttribInfo - member attrib_SetsRequiredMembersAttribute: BuiltinAttribInfo - - member attrib_DecimalConstantAttribute: BuiltinAttribInfo member attrib_StructAttribute: BuiltinAttribInfo @@ -438,6 +424,7 @@ type internal TcGlobals = member attribs_Unsupported: TypedTree.TyconRef list + member bitwise_and_info: IntrinsicValRef member bitwise_and_vref: TypedTree.ValRef diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 51b99347589..6beda65ca5d 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3581,69 +3581,76 @@ let TryFindILAttribute (AttribInfo (atref, _)) attrs = let IsILAttrib (AttribInfo (builtInAttrRef, _)) attr = isILAttrib builtInAttrRef attr /// Compute well-known attribute flags for an ILAttributes collection. -/// This is the 'compute' callback passed to ILAttributesStored.HasWellKnownAttribute. -let computeILWellKnownFlags (_g: TcGlobals) (attrs: ILAttributes) : WellKnownILAttributes = - let mutable flags = WellKnownILAttributes.None +/// Classify a single IL attribute, returning its well-known flag (or None). +let classifyILAttrib (attr: ILAttribute) : WellKnownILAttributes = + let atref = attr.Method.DeclaringType.TypeSpec.TypeRef - for attr in attrs.AsArray() do - let atref = attr.Method.DeclaringType.TypeSpec.TypeRef + if not atref.Enclosing.IsEmpty then + WellKnownILAttributes.None + else + let name = atref.Name - if atref.Enclosing.IsEmpty then - let name = atref.Name + if name.StartsWith("System.Runtime.CompilerServices.") then + match name with + | "System.Runtime.CompilerServices.IsReadOnlyAttribute" -> WellKnownILAttributes.IsReadOnlyAttribute + | "System.Runtime.CompilerServices.IsUnmanagedAttribute" -> WellKnownILAttributes.IsUnmanagedAttribute + | "System.Runtime.CompilerServices.ExtensionAttribute" -> WellKnownILAttributes.ExtensionAttribute + | "System.Runtime.CompilerServices.IsByRefLikeAttribute" -> WellKnownILAttributes.IsByRefLikeAttribute + | "System.Runtime.CompilerServices.InternalsVisibleToAttribute" -> WellKnownILAttributes.InternalsVisibleToAttribute + | "System.Runtime.CompilerServices.CallerMemberNameAttribute" -> WellKnownILAttributes.CallerMemberNameAttribute + | "System.Runtime.CompilerServices.CallerFilePathAttribute" -> WellKnownILAttributes.CallerFilePathAttribute + | "System.Runtime.CompilerServices.CallerLineNumberAttribute" -> WellKnownILAttributes.CallerLineNumberAttribute + | "System.Runtime.CompilerServices.RequiresLocationAttribute" -> WellKnownILAttributes.RequiresLocationAttribute + | "System.Runtime.CompilerServices.NullableAttribute" -> WellKnownILAttributes.NullableAttribute + | "System.Runtime.CompilerServices.NullableContextAttribute" -> WellKnownILAttributes.NullableContextAttribute + | "System.Runtime.CompilerServices.IDispatchConstantAttribute" -> WellKnownILAttributes.IDispatchConstantAttribute + | "System.Runtime.CompilerServices.IUnknownConstantAttribute" -> WellKnownILAttributes.IUnknownConstantAttribute + | "System.Runtime.CompilerServices.SetsRequiredMembersAttribute" -> WellKnownILAttributes.SetsRequiredMembersAttribute + | "System.Runtime.CompilerServices.CompilerFeatureRequiredAttribute" -> WellKnownILAttributes.CompilerFeatureRequiredAttribute + | "System.Runtime.CompilerServices.RequiredMemberAttribute" -> WellKnownILAttributes.RequiredMemberAttribute + | _ -> WellKnownILAttributes.None + + elif name.StartsWith("Microsoft.FSharp.Core.") then + match name with + | "Microsoft.FSharp.Core.AllowNullLiteralAttribute" -> WellKnownILAttributes.AllowNullLiteralAttribute + | "Microsoft.FSharp.Core.ReflectedDefinitionAttribute" -> WellKnownILAttributes.ReflectedDefinitionAttribute + | "Microsoft.FSharp.Core.AutoOpenAttribute" -> WellKnownILAttributes.AutoOpenAttribute + | "Microsoft.FSharp.Core.CompilerServices.NoEagerConstraintApplicationAttribute" -> + WellKnownILAttributes.NoEagerConstraintApplicationAttribute + | _ -> WellKnownILAttributes.None - if name.StartsWith("System.Runtime.CompilerServices.") then - match name with - | "System.Runtime.CompilerServices.IsReadOnlyAttribute" -> - flags <- flags ||| WellKnownILAttributes.IsReadOnlyAttribute - | "System.Runtime.CompilerServices.IsUnmanagedAttribute" -> - flags <- flags ||| WellKnownILAttributes.IsUnmanagedAttribute - | "System.Runtime.CompilerServices.ExtensionAttribute" -> - flags <- flags ||| WellKnownILAttributes.ExtensionAttribute - | "System.Runtime.CompilerServices.IsByRefLikeAttribute" -> - flags <- flags ||| WellKnownILAttributes.IsByRefLikeAttribute - | "System.Runtime.CompilerServices.InternalsVisibleToAttribute" -> - flags <- flags ||| WellKnownILAttributes.InternalsVisibleToAttribute - | "System.Runtime.CompilerServices.CallerMemberNameAttribute" -> - flags <- flags ||| WellKnownILAttributes.CallerMemberNameAttribute - | "System.Runtime.CompilerServices.CallerFilePathAttribute" -> - flags <- flags ||| WellKnownILAttributes.CallerFilePathAttribute - | "System.Runtime.CompilerServices.CallerLineNumberAttribute" -> - flags <- flags ||| WellKnownILAttributes.CallerLineNumberAttribute - | "System.Runtime.CompilerServices.RequiresLocationAttribute" -> - flags <- flags ||| WellKnownILAttributes.RequiresLocationAttribute - | "System.Runtime.CompilerServices.NullableAttribute" -> - flags <- flags ||| WellKnownILAttributes.NullableAttribute - | "System.Runtime.CompilerServices.IDispatchConstantAttribute" -> - flags <- flags ||| WellKnownILAttributes.IDispatchConstantAttribute - | "System.Runtime.CompilerServices.IUnknownConstantAttribute" -> - flags <- flags ||| WellKnownILAttributes.IUnknownConstantAttribute - | "System.Runtime.CompilerServices.SetsRequiredMembersAttribute" -> - flags <- flags ||| WellKnownILAttributes.SetsRequiredMembersAttribute - | _ -> () + else + match name with + | "System.ParamArrayAttribute" -> WellKnownILAttributes.ParamArrayAttribute + | "System.Reflection.DefaultMemberAttribute" -> WellKnownILAttributes.DefaultMemberAttribute + | "System.Diagnostics.CodeAnalysis.SetsRequiredMembersAttribute" -> + WellKnownILAttributes.SetsRequiredMembersAttribute + | "System.ObsoleteAttribute" -> WellKnownILAttributes.ObsoleteAttribute + | "System.Diagnostics.CodeAnalysis.ExperimentalAttribute" -> WellKnownILAttributes.ExperimentalAttribute + | "System.AttributeUsageAttribute" -> WellKnownILAttributes.AttributeUsageAttribute + | _ -> WellKnownILAttributes.None - elif name.StartsWith("Microsoft.FSharp.Core.") then - match name with - | "Microsoft.FSharp.Core.AllowNullLiteralAttribute" -> - flags <- flags ||| WellKnownILAttributes.AllowNullLiteralAttribute - | "Microsoft.FSharp.Core.ReflectedDefinitionAttribute" -> - flags <- flags ||| WellKnownILAttributes.ReflectedDefinitionAttribute - | "Microsoft.FSharp.Core.AutoOpenAttribute" -> - flags <- flags ||| WellKnownILAttributes.AutoOpenAttribute - | "Microsoft.FSharp.Core.CompilerServices.NoEagerConstraintApplicationAttribute" -> - flags <- flags ||| WellKnownILAttributes.NoEagerConstraintApplicationAttribute - | _ -> () +/// Compute well-known attribute flags for an ILAttributes collection. +let computeILWellKnownFlags (_g: TcGlobals) (attrs: ILAttributes) : WellKnownILAttributes = + let mutable flags = WellKnownILAttributes.None + for attr in attrs.AsArray() do + flags <- flags ||| classifyILAttrib attr + flags - else - match name with - | "System.ParamArrayAttribute" -> flags <- flags ||| WellKnownILAttributes.ParamArrayAttribute - | "System.Reflection.DefaultMemberAttribute" -> - flags <- flags ||| WellKnownILAttributes.DefaultMemberAttribute - | "System.Diagnostics.CodeAnalysis.SetsRequiredMembersAttribute" -> - flags <- flags ||| WellKnownILAttributes.SetsRequiredMembersAttribute - | "System.ObsoleteAttribute" -> flags <- flags ||| WellKnownILAttributes.ObsoleteAttribute - | _ -> () +/// Find the first IL attribute matching a specific well-known flag and decode it. +let tryFindILAttribByFlag (flag: WellKnownILAttributes) (cattrs: ILAttributes) = + cattrs.AsArray() + |> Array.tryPick (fun attr -> + if classifyILAttrib attr &&& flag <> WellKnownILAttributes.None then + Some(decodeILAttribData attr) + else + None) - flags +/// Active pattern: find and decode a well-known IL attribute. +/// Returns decoded (ILAttribElem list * ILAttributeNamedArg list). +[] +let (|ILAttribDecoded|_|) (flag: WellKnownILAttributes) (cattrs: ILAttributes) = + tryFindILAttribByFlag flag cattrs |> ValueOption.ofOption type ILAttributesStored with diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index bdaf8f0766e..e619102975c 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2375,8 +2375,16 @@ val IsILAttrib: BuiltinAttribInfo -> ILAttribute -> bool val TryFindILAttribute: BuiltinAttribInfo -> ILAttributes -> bool /// Compute well-known attribute flags for an ILAttributes collection. +val classifyILAttrib: attr: ILAttribute -> WellKnownILAttributes + val computeILWellKnownFlags: _g: TcGlobals -> attrs: ILAttributes -> WellKnownILAttributes +val tryFindILAttribByFlag: flag: WellKnownILAttributes -> cattrs: ILAttributes -> (ILAttribElem list * ILAttributeNamedArg list) option + +[] +val (|ILAttribDecoded|_|): + flag: WellKnownILAttributes -> cattrs: ILAttributes -> (ILAttribElem list * ILAttributeNamedArg list) voption + type ILAttributesStored with member HasWellKnownAttribute: g: TcGlobals * flag: WellKnownILAttributes -> bool From bea5489fc0a49e34422b7eb7add1e598c064755e Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Sun, 1 Mar 2026 20:32:53 +0100 Subject: [PATCH 51/71] Delete attrib_IlExperimentalAttribute (zero callers) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit g.attrib_ members: 95 → 35 (60 deleted total) Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TcGlobals.fs | 1 - src/Compiler/TypedTree/TcGlobals.fsi | 1 - 2 files changed, 2 deletions(-) diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index cc8ce47da6f..79343fd96d3 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -1510,7 +1510,6 @@ type TcGlobals( member val attrib_SecurityAttribute = tryFindSysAttrib "System.Security.Permissions.SecurityAttribute" member val attrib_SecurityCriticalAttribute = findSysAttrib "System.Security.SecurityCriticalAttribute" member val attrib_SecuritySafeCriticalAttribute = findSysAttrib "System.Security.SecuritySafeCriticalAttribute" - member val attrib_IlExperimentalAttribute = findSysAttrib "System.Diagnostics.CodeAnalysis.ExperimentalAttribute" member g.improveType tcref tinst = improveTy tcref tinst diff --git a/src/Compiler/TypedTree/TcGlobals.fsi b/src/Compiler/TypedTree/TcGlobals.fsi index 13227cedf35..6e0ba91cacb 100644 --- a/src/Compiler/TypedTree/TcGlobals.fsi +++ b/src/Compiler/TypedTree/TcGlobals.fsi @@ -420,7 +420,6 @@ type internal TcGlobals = member attrib_TypeForwardedToAttribute: BuiltinAttribInfo - member attrib_IlExperimentalAttribute: BuiltinAttribInfo member attribs_Unsupported: TypedTree.TyconRef list From 4d3600305f7a6068d77d706ed9067a70a1a79fa0 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 2 Mar 2026 13:57:28 +0100 Subject: [PATCH 52/71] Audit cleanup: hasFlag helper, CheckFlag dedup, ILAttributes extension, docs - Add inline hasFlag helper to replace 37 verbose &&& <> None patterns - Add CheckFlag method to WellKnownAttribs struct, dedup 3 cache functions - Add ILAttributes.HasWellKnownAttribute extension for non-caching checks - Fix ILPropInfo.IsRequired to use cached HasWellKnownAttribute - Simplify CheckRequiredProperties to use ILAttributes extension - Document WellKnownAssemblyAttributes uint32 choice - Update surface area baseline for new WellKnownILAttributes members - Fix DefaultValue(false) regression: zeroInit must match both True and False flags Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/CheckDeclarations.fs | 43 ++++++++-------- .../Checking/Expressions/CheckExpressions.fs | 30 +++++------ src/Compiler/Checking/NameResolution.fs | 2 +- src/Compiler/Checking/infos.fs | 3 +- src/Compiler/CodeGen/IlxGen.fs | 14 ++---- src/Compiler/TypedTree/TypedTreeOps.fs | 50 ++++++++----------- src/Compiler/TypedTree/TypedTreeOps.fsi | 7 +++ src/Compiler/TypedTree/WellKnownAttribs.fs | 27 +++++++--- src/Compiler/TypedTree/WellKnownAttribs.fsi | 13 ++--- ...iler.Service.SurfaceArea.netstandard20.bsl | 5 ++ 10 files changed, 99 insertions(+), 95 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index c31675e52ea..883f68db06e 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -435,14 +435,11 @@ module TcRecdUnionAndEnumDeclarations = let attrsForField = (List.map snd attrsForField) let tyR, _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurrence.UseInType WarnOnIWSAM.Yes env tpenv ty let fieldFlags = computeValWellKnownFlags g attrsForField - let zeroInit = fieldFlags &&& WellKnownValAttributes.DefaultValueAttribute_True <> WellKnownValAttributes.None - let isVolatile = fieldFlags &&& WellKnownValAttributes.VolatileFieldAttribute <> WellKnownValAttributes.None + let zeroInit = hasFlag fieldFlags (WellKnownValAttributes.DefaultValueAttribute_True ||| WellKnownValAttributes.DefaultValueAttribute_False) + let isVolatile = hasFlag fieldFlags WellKnownValAttributes.VolatileFieldAttribute let isThreadStatic = - fieldFlags - &&& (WellKnownValAttributes.ThreadStaticAttribute - ||| WellKnownValAttributes.ContextStaticAttribute) - <> WellKnownValAttributes.None + hasFlag fieldFlags (WellKnownValAttributes.ThreadStaticAttribute ||| WellKnownValAttributes.ContextStaticAttribute) if isThreadStatic && (not zeroInit || not isStatic) then errorR(Error(FSComp.SR.tcThreadStaticAndContextStaticMustBeStatic(), m)) @@ -2555,11 +2552,11 @@ module EstablishTypeDefinitionCores = let private GetTyconAttribs g attrs = let flags = computeEntityWellKnownFlags g attrs - let hasClassAttr = flags &&& WellKnownEntityAttributes.ClassAttribute <> WellKnownEntityAttributes.None - let hasAbstractClassAttr = flags &&& WellKnownEntityAttributes.AbstractClassAttribute <> WellKnownEntityAttributes.None - let hasInterfaceAttr = flags &&& WellKnownEntityAttributes.InterfaceAttribute <> WellKnownEntityAttributes.None - let hasStructAttr = flags &&& WellKnownEntityAttributes.StructAttribute <> WellKnownEntityAttributes.None - let hasMeasureAttr = flags &&& WellKnownEntityAttributes.MeasureAttribute <> WellKnownEntityAttributes.None + let hasClassAttr = hasFlag flags WellKnownEntityAttributes.ClassAttribute + let hasAbstractClassAttr = hasFlag flags WellKnownEntityAttributes.AbstractClassAttribute + let hasInterfaceAttr = hasFlag flags WellKnownEntityAttributes.InterfaceAttribute + let hasStructAttr = hasFlag flags WellKnownEntityAttributes.StructAttribute + let hasMeasureAttr = hasFlag flags WellKnownEntityAttributes.MeasureAttribute (hasClassAttr, hasAbstractClassAttr, hasInterfaceAttr, hasStructAttr, hasMeasureAttr) //------------------------------------------------------------------------- @@ -2858,12 +2855,12 @@ module EstablishTypeDefinitionCores = // Allow failure of constructor resolution because Vals for members in the same recursive group are not yet available let attrs, getFinalAttrs = TcAttributesCanFail cenv envinner AttributeTargets.TyconDecl synAttrs let entityFlags = computeEntityWellKnownFlags g attrs - let hasMeasureAttr = entityFlags &&& WellKnownEntityAttributes.MeasureAttribute <> WellKnownEntityAttributes.None - let hasStructAttr = entityFlags &&& WellKnownEntityAttributes.StructAttribute <> WellKnownEntityAttributes.None - let hasCLIMutable = entityFlags &&& WellKnownEntityAttributes.CLIMutableAttribute <> WellKnownEntityAttributes.None - let hasAllowNullLiteralAttr = entityFlags &&& WellKnownEntityAttributes.AllowNullLiteralAttribute_True <> WellKnownEntityAttributes.None - let hasSealedAttr = entityFlags &&& WellKnownEntityAttributes.SealedAttribute_True <> WellKnownEntityAttributes.None - let structLayoutAttr = entityFlags &&& WellKnownEntityAttributes.StructLayoutAttribute <> WellKnownEntityAttributes.None + let hasMeasureAttr = hasFlag entityFlags WellKnownEntityAttributes.MeasureAttribute + let hasStructAttr = hasFlag entityFlags WellKnownEntityAttributes.StructAttribute + let hasCLIMutable = hasFlag entityFlags WellKnownEntityAttributes.CLIMutableAttribute + let hasAllowNullLiteralAttr = hasFlag entityFlags WellKnownEntityAttributes.AllowNullLiteralAttribute_True + let hasSealedAttr = hasFlag entityFlags WellKnownEntityAttributes.SealedAttribute_True + let structLayoutAttr = hasFlag entityFlags WellKnownEntityAttributes.StructLayoutAttribute // We want to keep these special attributes treatment and avoid having two errors for the same attribute. let reportAttributeTargetsErrors = @@ -3405,28 +3402,28 @@ module EstablishTypeDefinitionCores = let thisTyInst, thisTy = generalizeTyconRef g thisTyconRef let entityFlags = computeEntityWellKnownFlags g attrs - let hasAbstractAttr = entityFlags &&& WellKnownEntityAttributes.AbstractClassAttribute <> WellKnownEntityAttributes.None + let hasAbstractAttr = hasFlag entityFlags WellKnownEntityAttributes.AbstractClassAttribute let hasSealedAttr = // The special case is needed for 'unit' because the 'Sealed' attribute is not yet available when this type is defined. if g.compilingFSharpCore && id.idText = "Unit" then Some true - elif entityFlags &&& WellKnownEntityAttributes.SealedAttribute_True <> WellKnownEntityAttributes.None then + elif hasFlag entityFlags WellKnownEntityAttributes.SealedAttribute_True then Some true - elif entityFlags &&& WellKnownEntityAttributes.SealedAttribute_False <> WellKnownEntityAttributes.None then + elif hasFlag entityFlags WellKnownEntityAttributes.SealedAttribute_False then Some false else None - let hasMeasureAttr = entityFlags &&& WellKnownEntityAttributes.MeasureAttribute <> WellKnownEntityAttributes.None + let hasMeasureAttr = hasFlag entityFlags WellKnownEntityAttributes.MeasureAttribute // REVIEW: for hasMeasureableAttr we need to be stricter about checking these // are only used on exactly the right kinds of type definitions and not in conjunction with other attributes. - let hasMeasureableAttr = entityFlags &&& WellKnownEntityAttributes.MeasureableAttribute <> WellKnownEntityAttributes.None + let hasMeasureableAttr = hasFlag entityFlags WellKnownEntityAttributes.MeasureableAttribute let structLayoutAttr = match attrs with | EntityAttribInt g WellKnownEntityAttributes.StructLayoutAttribute v -> Some v | _ -> None - let hasAllowNullLiteralAttr = entityFlags &&& WellKnownEntityAttributes.AllowNullLiteralAttribute_True <> WellKnownEntityAttributes.None + let hasAllowNullLiteralAttr = hasFlag entityFlags WellKnownEntityAttributes.AllowNullLiteralAttribute_True if hasAbstractAttr then tycon.TypeContents.tcaug_abstract <- true diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 93bc4eec737..b829b9d3eed 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -1325,14 +1325,8 @@ let CheckRequiredProperties (g:TcGlobals) (env: TcEnv) (cenv: TcFileState) (minf // 3. If some are missing, produce a diagnostic which missing ones. if g.langVersion.SupportsFeature(LanguageFeature.RequiredPropertiesSupport) && minfo.IsConstructor - && not ( - match minfo with - | ILMeth(_, ilMethInfo, _) -> - ilMethInfo.RawMetadata.HasWellKnownAttribute(g, WellKnownILAttributes.SetsRequiredMembersAttribute) - | _ -> - tryFindILAttribByFlag WellKnownILAttributes.SetsRequiredMembersAttribute (minfo.GetCustomAttrs()) - |> Option.isSome - ) then + && not (minfo.GetCustomAttrs().HasWellKnownAttribute(WellKnownILAttributes.SetsRequiredMembersAttribute)) + then let requiredProps = [ @@ -1406,7 +1400,7 @@ let MakeAndPublishVal (cenv: cenv) env (altActualParent, inSig, declKind, valRec let valFlags = computeValWellKnownFlags g attrs let inlineFlag = - if valFlags &&& WellKnownValAttributes.DllImportAttribute <> WellKnownValAttributes.None then + if hasFlag valFlags WellKnownValAttributes.DllImportAttribute then if inlineFlag = ValInline.Always then errorR(Error(FSComp.SR.tcDllImportStubsCannotBeInlined(), m)) ValInline.Never @@ -2390,7 +2384,7 @@ let ComputeInlineFlag (memFlagsOption: SynMemberFlags option) isInline isMutable let valFlags = computeValWellKnownFlags g attrs let hasNoCompilerInliningAttribute () = - valFlags &&& WellKnownValAttributes.NoCompilerInliningAttribute <> WellKnownValAttributes.None + hasFlag valFlags WellKnownValAttributes.NoCompilerInliningAttribute let isCtorOrAbstractSlot () = match memFlagsOption with @@ -2398,7 +2392,7 @@ let ComputeInlineFlag (memFlagsOption: SynMemberFlags option) isInline isMutable | Some x -> (x.MemberKind = SynMemberKind.Constructor) || x.IsDispatchSlot || x.IsOverrideOrExplicitImpl let isExtern () = - valFlags &&& WellKnownValAttributes.DllImportAttribute <> WellKnownValAttributes.None + hasFlag valFlags WellKnownValAttributes.DllImportAttribute let inlineFlag, reportIncorrectInlineKeywordUsage = // Mutable values may never be inlined @@ -11155,7 +11149,7 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt let valAttribFlags = computeValWellKnownFlags g valAttribs - let isVolatile = valAttribFlags &&& WellKnownValAttributes.VolatileFieldAttribute <> WellKnownValAttributes.None + let isVolatile = hasFlag valAttribFlags WellKnownValAttributes.VolatileFieldAttribute let inlineFlag = ComputeInlineFlag memberFlagsOpt isInline isMutable g valAttribs mBinding let argAttribs = @@ -11179,11 +11173,11 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt | _ -> false | _ -> false - let hasDefaultValueAttr = valAttribFlags &&& (WellKnownValAttributes.DefaultValueAttribute_True ||| WellKnownValAttributes.DefaultValueAttribute_False) <> WellKnownValAttributes.None + let hasDefaultValueAttr = hasFlag valAttribFlags (WellKnownValAttributes.DefaultValueAttribute_True ||| WellKnownValAttributes.DefaultValueAttribute_False) if hasDefaultValueAttr && not isZeroMethod then errorR(Error(FSComp.SR.tcDefaultValueAttributeRequiresVal(), mBinding)) - let isThreadStatic = valAttribFlags &&& (WellKnownValAttributes.ThreadStaticAttribute ||| WellKnownValAttributes.ContextStaticAttribute) <> WellKnownValAttributes.None + let isThreadStatic = hasFlag valAttribFlags (WellKnownValAttributes.ThreadStaticAttribute ||| WellKnownValAttributes.ContextStaticAttribute) if isThreadStatic then errorR(DeprecatedThreadStaticBindingWarning mBinding) if isVolatile then @@ -11198,13 +11192,13 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt errorR(Error(FSComp.SR.tcFixedNotAllowed(), mBinding)) if (not declKind.CanBeDllImport || (match memberFlagsOpt with Some memberFlags -> memberFlags.IsInstance | _ -> false)) && - valAttribFlags &&& WellKnownValAttributes.DllImportAttribute <> WellKnownValAttributes.None then + hasFlag valAttribFlags WellKnownValAttributes.DllImportAttribute then errorR(Error(FSComp.SR.tcDllImportNotAllowed(), mBinding)) - if Option.isNone memberFlagsOpt && valAttribFlags &&& WellKnownValAttributes.ConditionalAttribute <> WellKnownValAttributes.None then + if Option.isNone memberFlagsOpt && hasFlag valAttribFlags WellKnownValAttributes.ConditionalAttribute then errorR(Error(FSComp.SR.tcConditionalAttributeRequiresMembers(), mBinding)) - if valAttribFlags &&& WellKnownValAttributes.EntryPointAttribute <> WellKnownValAttributes.None then + if hasFlag valAttribFlags WellKnownValAttributes.EntryPointAttribute then if Option.isSome memberFlagsOpt then errorR(Error(FSComp.SR.tcEntryPointAttributeRequiresFunctionInModule(), mBinding)) else @@ -11390,7 +11384,7 @@ and TcLiteral (cenv: cenv) overallTy env tpenv (attrs, synLiteralValExpr) = let valFlags = computeValWellKnownFlags g attrs let hasLiteralAttr = - valFlags &&& WellKnownValAttributes.LiteralAttribute <> WellKnownValAttributes.None + hasFlag valFlags WellKnownValAttributes.LiteralAttribute if hasLiteralAttr then let literalValExpr, _ = TcExpr cenv (MustEqual overallTy) env tpenv synLiteralValExpr diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index b5ea8a23dbe..3ea2a6c33ba 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -96,7 +96,7 @@ let ActivePatternElemsOfValRef g (vref: ValRef) = let hasStructAttribute() = vref.Attribs |> List.exists (function - | Attrib(targetsOpt = Some(System.AttributeTargets.ReturnValue)) as a -> classifyValAttrib g a &&& WellKnownValAttributes.StructAttribute <> WellKnownValAttributes.None + | Attrib(targetsOpt = Some(System.AttributeTargets.ReturnValue)) as a -> hasFlag (classifyValAttrib g a) WellKnownValAttributes.StructAttribute | _ -> false) if isValueOptionTy g apReturnTy || hasStructAttribute() then ActivePatternReturnKind.StructTypeWrapper elif isBoolTy g apReturnTy then ActivePatternReturnKind.Boolean diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index f41d3e86952..b4f800e185a 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -1755,8 +1755,7 @@ type ILPropInfo = /// Indicates if the property is required, i.e. has RequiredMemberAttribute applied. member x.IsRequired = - tryFindILAttribByFlag WellKnownILAttributes.RequiredMemberAttribute x.RawMetadata.CustomAttrs - |> Option.isSome + x.RawMetadata.CustomAttrsStored.HasWellKnownAttribute(x.TcGlobals, WellKnownILAttributes.RequiredMemberAttribute) /// Get the names and types of the indexer arguments associated with the IL property. /// diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index be470a2fe27..b7b9e7e7312 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -8947,16 +8947,12 @@ and GenParamAttribs cenv paramTy attribs = let valFlags = computeValWellKnownFlags g attribs let inFlag = - valFlags &&& WellKnownValAttributes.InAttribute <> WellKnownValAttributes.None - || isInByrefTy g paramTy + hasFlag valFlags WellKnownValAttributes.InAttribute || isInByrefTy g paramTy let outFlag = - valFlags &&& WellKnownValAttributes.OutAttribute <> WellKnownValAttributes.None - || isOutByrefTy g paramTy + hasFlag valFlags WellKnownValAttributes.OutAttribute || isOutByrefTy g paramTy - let optionalFlag = - valFlags &&& WellKnownValAttributes.OptionalAttribute - <> WellKnownValAttributes.None + let optionalFlag = hasFlag valFlags WellKnownValAttributes.OptionalAttribute let defaultValue = tryFindValAttribByFlag g WellKnownValAttributes.DefaultParameterValueAttribute attribs @@ -11025,9 +11021,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option // DebugDisplayAttribute gets copied to the subtypes generated as part of DU compilation let debugDisplayAttrs, normalAttrs = tycon.Attribs - |> List.partition (fun a -> - classifyEntityAttrib g a &&& WellKnownEntityAttributes.DebuggerDisplayAttribute - <> WellKnownEntityAttributes.None) + |> List.partition (fun a -> hasFlag (classifyEntityAttrib g a) WellKnownEntityAttributes.DebuggerDisplayAttribute) let securityAttrs, normalAttrs = normalAttrs diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 6beda65ca5d..d72759a7d01 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3580,6 +3580,11 @@ let TryFindILAttribute (AttribInfo (atref, _)) attrs = let IsILAttrib (AttribInfo (builtInAttrRef, _)) attr = isILAttrib builtInAttrRef attr +let inline hasFlag (flags: ^F) (flag: ^F) : bool when ^F: enum = + let f = LanguagePrimitives.EnumToValue flags + let v = LanguagePrimitives.EnumToValue flag + f &&& v <> 0uL + /// Compute well-known attribute flags for an ILAttributes collection. /// Classify a single IL attribute, returning its well-known flag (or None). let classifyILAttrib (attr: ILAttribute) : WellKnownILAttributes = @@ -3672,6 +3677,12 @@ type ILFieldDef with member x.HasWellKnownAttribute(g: TcGlobals, flag: WellKnownILAttributes) = x.CustomAttrsStored.HasWellKnownAttribute(g, flag) +type ILAttributes with + + /// Non-caching (unlike ILAttributesStored.HasWellKnownAttribute which caches). + member x.HasWellKnownAttribute(flag: WellKnownILAttributes) = + x.AsArray() |> Array.exists (fun attr -> classifyILAttrib attr &&& flag <> WellKnownILAttributes.None) + /// Resolve the FSharp.Core path for an attribute's type reference. /// Returns ValueSome path for FSharp.Core attributes, calls bclDispatch for BCL attributes, ValueNone otherwise. let inline resolveAttribPath (g: TcGlobals) (tcref: TyconRef) (bclDispatch: string[] -> unit) : string[] voption = @@ -3931,14 +3942,9 @@ let attribsHaveEntityFlag g (flag: WellKnownEntityAttributes) (attribs: Attribs) /// Check if an Entity has a specific well-known attribute, computing and caching flags if needed. let EntityHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownEntityAttributes) (entity: Entity) : bool = let ea = entity.EntityAttribs - - if ea.Flags &&& WellKnownEntityAttributes.NotComputed <> WellKnownEntityAttributes.None then - let attribs = ea.AsList() - let flags = computeEntityWellKnownFlags g attribs - entity.SetEntityAttribs(WellKnownEntityAttribs.CreateWithFlags(attribs, flags)) - flags &&& flag <> WellKnownEntityAttributes.None - else - ea.HasWellKnownAttribute(flag) + let struct (result, wa) = ea.CheckFlag(flag, computeEntityWellKnownFlags g) + if wa.Flags <> ea.Flags then entity.SetEntityAttribs(wa) + result /// Classify a single Val-level attribute, returning its well-known flag (or None). let classifyValAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownValAttributes = @@ -4066,26 +4072,16 @@ let filterOutWellKnownAttribs /// Check if an ArgReprInfo has a specific well-known attribute, computing and caching flags if needed. let ArgReprInfoHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownValAttributes) (argInfo: ArgReprInfo) : bool = let wa = argInfo.Attribs - - if wa.Flags &&& WellKnownValAttributes.NotComputed <> WellKnownValAttributes.None then - let attribs = wa.AsList() - let flags = computeValWellKnownFlags g attribs - argInfo.Attribs <- WellKnownValAttribs.CreateWithFlags(attribs, flags) - flags &&& flag <> WellKnownValAttributes.None - else - wa.HasWellKnownAttribute(flag) + let struct (result, waNew) = wa.CheckFlag(flag, computeValWellKnownFlags g) + if waNew.Flags <> wa.Flags then argInfo.Attribs <- waNew + result /// Check if a Val has a specific well-known attribute, computing and caching flags if needed. let ValHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownValAttributes) (v: Val) : bool = let va = v.ValAttribs - - if va.Flags &&& WellKnownValAttributes.NotComputed <> WellKnownValAttributes.None then - let attribs = va.AsList() - let flags = computeValWellKnownFlags g attribs - v.SetValAttribs(WellKnownValAttribs.CreateWithFlags(attribs, flags)) - flags &&& flag <> WellKnownValAttributes.None - else - va.HasWellKnownAttribute(flag) + let struct (result, waNew) = va.CheckFlag(flag, computeValWellKnownFlags g) + if waNew.Flags <> va.Flags then v.SetValAttribs(waNew) + result /// Query a three-state bool attribute on an entity. Returns bool option. let EntityTryGetBoolAttribute (g: TcGlobals) (trueFlag: WellKnownEntityAttributes) (falseFlag: WellKnownEntityAttributes) (entity: Entity) : bool option = @@ -10045,12 +10041,10 @@ let MemberIsCompiledAsInstance g parent isExtensionMember (membInfo: ValMemberIn let entityFlags = computeEntityWellKnownFlags g attrs let explicitInstance = - entityFlags &&& WellKnownEntityAttributes.CompilationRepresentation_Instance - <> WellKnownEntityAttributes.None + hasFlag entityFlags WellKnownEntityAttributes.CompilationRepresentation_Instance let explicitStatic = - entityFlags &&& WellKnownEntityAttributes.CompilationRepresentation_Static - <> WellKnownEntityAttributes.None + hasFlag entityFlags WellKnownEntityAttributes.CompilationRepresentation_Static explicitInstance || (membInfo.MemberFlags.IsInstance && not explicitStatic && diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index e619102975c..b4114051b8d 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2374,6 +2374,8 @@ val IsILAttrib: BuiltinAttribInfo -> ILAttribute -> bool val TryFindILAttribute: BuiltinAttribInfo -> ILAttributes -> bool +val inline hasFlag: flags: ^F -> flag: ^F -> bool when ^F: enum + /// Compute well-known attribute flags for an ILAttributes collection. val classifyILAttrib: attr: ILAttribute -> WellKnownILAttributes @@ -2401,6 +2403,11 @@ type ILFieldDef with member HasWellKnownAttribute: g: TcGlobals * flag: WellKnownILAttributes -> bool +type ILAttributes with + + /// Non-caching (unlike ILAttributesStored.HasWellKnownAttribute which caches). + member HasWellKnownAttribute: flag: WellKnownILAttributes -> bool + /// Compute well-known attribute flags for an Entity's Attrib list. val computeEntityWellKnownFlags: g: TcGlobals -> attribs: Attribs -> WellKnownEntityAttributes diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fs b/src/Compiler/TypedTree/WellKnownAttribs.fs index c6efe085814..c3d19d16776 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fs +++ b/src/Compiler/TypedTree/WellKnownAttribs.fs @@ -60,15 +60,14 @@ type internal WellKnownEntityAttributes = | NotComputed = (1uL <<< 63) /// Flags enum for well-known assembly-level attributes. -/// Used to avoid O(N) linear scans of attribute lists. [] type internal WellKnownAssemblyAttributes = - | None = 0u - | AutoOpenAttribute = (1u <<< 0) - | InternalsVisibleToAttribute = (1u <<< 1) - | AssemblyCultureAttribute = (1u <<< 2) - | AssemblyVersionAttribute = (1u <<< 3) - | NotComputed = (1u <<< 31) + | None = 0uL + | AutoOpenAttribute = (1uL <<< 0) + | InternalsVisibleToAttribute = (1uL <<< 1) + | AssemblyCultureAttribute = (1uL <<< 2) + | AssemblyVersionAttribute = (1uL <<< 3) + | NotComputed = (1uL <<< 63) /// Flags enum for well-known attributes on Val (values and members). /// Used to avoid O(N) linear scans of attribute lists. @@ -156,3 +155,17 @@ type internal WellKnownAttribs<'TItem, 'TFlags when 'TFlags: enum> = WellKnownAttribs<'TItem, 'TFlags>([], LanguagePrimitives.EnumOfValue 0uL) else WellKnownAttribs<'TItem, 'TFlags>(x.attribs, LanguagePrimitives.EnumOfValue(1uL <<< 63)) + + /// Caller must write back the returned wrapper if flags were recomputed. + member x.CheckFlag(flag: 'TFlags, compute: 'TItem list -> 'TFlags) : struct (bool * WellKnownAttribs<'TItem, 'TFlags>) = + let f = LanguagePrimitives.EnumToValue x.flags + + if f &&& (1uL <<< 63) <> 0uL then + let computed = compute x.attribs + let wa = WellKnownAttribs<'TItem, 'TFlags>(x.attribs, computed) + + struct (LanguagePrimitives.EnumToValue computed &&& LanguagePrimitives.EnumToValue flag + <> 0uL, + wa) + else + struct (x.HasWellKnownAttribute(flag), x) diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fsi b/src/Compiler/TypedTree/WellKnownAttribs.fsi index 8a6b05e666f..ed98e06ce7f 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fsi +++ b/src/Compiler/TypedTree/WellKnownAttribs.fsi @@ -61,12 +61,12 @@ type internal WellKnownEntityAttributes = /// Flags enum for well-known assembly-level attributes. [] type internal WellKnownAssemblyAttributes = - | None = 0u - | AutoOpenAttribute = (1u <<< 0) - | InternalsVisibleToAttribute = (1u <<< 1) - | AssemblyCultureAttribute = (1u <<< 2) - | AssemblyVersionAttribute = (1u <<< 3) - | NotComputed = (1u <<< 31) + | None = 0uL + | AutoOpenAttribute = (1uL <<< 0) + | InternalsVisibleToAttribute = (1uL <<< 1) + | AssemblyCultureAttribute = (1uL <<< 2) + | AssemblyVersionAttribute = (1uL <<< 3) + | NotComputed = (1uL <<< 63) /// Flags enum for well-known attributes on Val (values and members). [] @@ -125,3 +125,4 @@ type internal WellKnownAttribs<'TItem, 'TFlags when 'TFlags: enum> = member Add: attrib: 'TItem * flag: 'TFlags -> WellKnownAttribs<'TItem, 'TFlags> member Append: others: 'TItem list * flags: 'TFlags -> WellKnownAttribs<'TItem, 'TFlags> member WithRecomputedFlags: unit -> WellKnownAttribs<'TItem, 'TFlags> + member CheckFlag: flag: 'TFlags * compute: ('TItem list -> 'TFlags) -> struct (bool * WellKnownAttribs<'TItem, 'TFlags>) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl index 26abda52752..a248b48d23e 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl @@ -1820,11 +1820,14 @@ FSharp.Compiler.AbstractIL.IL+PublicKey: PublicKey NewPublicKeyToken(Byte[]) FSharp.Compiler.AbstractIL.IL+PublicKey: System.String ToString() FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: UInt32 value__ FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes AllowNullLiteralAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes AttributeUsageAttribute FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes AutoOpenAttribute FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes CallerFilePathAttribute FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes CallerLineNumberAttribute FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes CallerMemberNameAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes CompilerFeatureRequiredAttribute FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes DefaultMemberAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes ExperimentalAttribute FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes ExtensionAttribute FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes IDispatchConstantAttribute FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes IUnknownConstantAttribute @@ -1836,9 +1839,11 @@ FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes NoEag FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes None FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes NotComputed FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes NullableAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes NullableContextAttribute FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes ObsoleteAttribute FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes ParamArrayAttribute FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes ReflectedDefinitionAttribute +FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes RequiredMemberAttribute FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes RequiresLocationAttribute FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes: WellKnownILAttributes SetsRequiredMembersAttribute FSharp.Compiler.AbstractIL.IL: Boolean |HasFlag|_|(ILTypeDefAdditionalFlags, ILTypeDefAdditionalFlags) From 3a337290680024146bc8f8a8d5e4dd24f3239922 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 2 Mar 2026 15:55:00 +0100 Subject: [PATCH 53/71] Add MethInfoHasWellKnownAttribute for O(1) checks on overload resolution hot path Migrate NoEagerConstraintApplicationAttribute (2 callers in MethodCalls + CheckExpressions) and ExtensionAttribute (NameResolution) from linear-scan MethInfoHasAttribute to cached-flag MethInfoHasWellKnownAttribute. The new function dispatches to ILMethodDef.HasWellKnownAttribute (cached IL flags) for ILMeth and ValHasWellKnownAttribute (cached val flags) for FSMeth, with ProvidedMeth fallback to the old API. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/AttributeChecking.fs | 12 ++++++++++++ src/Compiler/Checking/AttributeChecking.fsi | 9 +++++++++ src/Compiler/Checking/CheckDeclarations.fs | 10 +++++----- .../Checking/Expressions/CheckExpressions.fs | 2 +- src/Compiler/Checking/MethodCalls.fs | 2 +- src/Compiler/Checking/NameResolution.fs | 2 +- src/Compiler/TypedTree/TcGlobals.fs | 1 - src/Compiler/TypedTree/TcGlobals.fsi | 5 ----- 8 files changed, 29 insertions(+), 14 deletions(-) diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index 3dc9e33c836..e273d0ce566 100755 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -231,6 +231,18 @@ let MethInfoHasAttribute g m attribSpec minfo = (fun _ -> Some ()) |> Option.isSome +/// Fast O(1) attribute check for ILMeth (cached IL flags) and FSMeth (cached Val flags). +/// Falls back to MethInfoHasAttribute for provided methods. +let rec MethInfoHasWellKnownAttribute g (m: range) (ilFlag: WellKnownILAttributes) (valFlag: WellKnownValAttributes) (attribSpec: BuiltinAttribInfo) (minfo: MethInfo) = + match minfo with + | ILMeth(_, ilMethInfo, _) -> ilMethInfo.RawMetadata.HasWellKnownAttribute(g, ilFlag) + | FSMeth(_, _, vref, _) -> ValHasWellKnownAttribute g valFlag vref.Deref + | DefaultStructCtor _ -> false + | MethInfoWithModifiedReturnType(mi, _) -> MethInfoHasWellKnownAttribute g m ilFlag valFlag attribSpec mi +#if !NO_TYPEPROVIDERS + | ProvidedMeth _ -> MethInfoHasAttribute g m attribSpec minfo +#endif + let private CheckCompilerFeatureRequiredAttribute (_g: TcGlobals) cattrs msg m = // In some cases C# will generate both ObsoleteAttribute and CompilerFeatureRequiredAttribute. // Specifically, when default constructor is generated for class with any required members in them. diff --git a/src/Compiler/Checking/AttributeChecking.fsi b/src/Compiler/Checking/AttributeChecking.fsi index 13c990d7c17..b3b3b897727 100644 --- a/src/Compiler/Checking/AttributeChecking.fsi +++ b/src/Compiler/Checking/AttributeChecking.fsi @@ -60,6 +60,15 @@ val TryFindMethInfoStringAttribute: val MethInfoHasAttribute: g: TcGlobals -> m: range -> attribSpec: BuiltinAttribInfo -> minfo: MethInfo -> bool +val MethInfoHasWellKnownAttribute: + g: TcGlobals -> + m: range -> + ilFlag: WellKnownILAttributes -> + valFlag: WellKnownValAttributes -> + attribSpec: BuiltinAttribInfo -> + minfo: MethInfo -> + bool + val CheckFSharpAttributes: g: TcGlobals -> attribs: Attrib list -> m: range -> OperationResult val CheckILAttributesForUnseen: g: TcGlobals -> cattrs: ILAttributes -> _m: 'a -> bool diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index 883f68db06e..0f37b4c71bf 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -3238,14 +3238,14 @@ module EstablishTypeDefinitionCores = // Give a warning if `AutoOpenAttribute` or `StructAttribute` is being aliased. // If the user were to alias the `Microsoft.FSharp.Core.AutoOpenAttribute` type, it would not be detected by the project graph dependency resolution algorithm. - let inline checkAttributeAliased ty (tycon: Tycon) (attrib: BuiltinAttribInfo) = + let inline checkAttributeAliased ty (tycon: Tycon) (fullName: string) = match stripTyEqns g ty with | AppTy g (tcref, _) when not tcref.IsErased -> match tcref.CompiledRepresentation with | CompiledTypeRepr.ILAsmOpen _ -> () | CompiledTypeRepr.ILAsmNamed _ -> - if tcref.CompiledRepresentationForNamedType.FullName = attrib.TypeRef.FullName then - warning(Error(FSComp.SR.chkAttributeAliased(attrib.TypeRef.FullName), tycon.Id.idRange)) + if tcref.CompiledRepresentationForNamedType.FullName = fullName then + warning(Error(FSComp.SR.chkAttributeAliased(fullName), tycon.Id.idRange)) | _ -> () // Check for attributes in unit-of-measure declarations @@ -3255,8 +3255,8 @@ module EstablishTypeDefinitionCores = | TType_measure tm -> CheckUnitOfMeasureAttributes g tm | _ -> () - checkAttributeAliased ty tycon g.attrib_AutoOpenAttribute - checkAttributeAliased ty tycon g.attrib_StructAttribute + checkAttributeAliased ty tycon "Microsoft.FSharp.Core.AutoOpenAttribute" + checkAttributeAliased ty tycon "Microsoft.FSharp.Core.StructAttribute" if not firstPass then let ftyvs = freeInTypeLeftToRight g false ty diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index b829b9d3eed..52e7c885cff 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -10228,7 +10228,7 @@ and TcMethodApplication_CheckArguments | Some (unnamedInfo, namedInfo) -> let calledObjArgTys = meth.CalledObjArgTys mMethExpr if (calledObjArgTys, callerObjArgTys) ||> Seq.forall2 (fun calledTy callerTy -> - let noEagerConstraintApplication = MethInfoHasAttribute g mMethExpr g.attrib_NoEagerConstraintApplicationAttribute meth.Method + let noEagerConstraintApplication = MethInfoHasWellKnownAttribute g mMethExpr WellKnownILAttributes.NoEagerConstraintApplicationAttribute WellKnownValAttributes.None g.attrib_NoEagerConstraintApplicationAttribute meth.Method // The logic associated with NoEagerConstraintApplicationAttribute is part of the // Tasks and Resumable Code RFC diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 285dfa4fa8c..54690913f1d 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -918,7 +918,7 @@ let ExamineArgumentForLambdaPropagation (infoReader: InfoReader) ad noEagerConst CalledArgMatchesType(adjustedCalledArgTy, noEagerConstraintApplication) let ExamineMethodForLambdaPropagation (g: TcGlobals) m (meth: CalledMeth) ad = - let noEagerConstraintApplication = MethInfoHasAttribute g m g.attrib_NoEagerConstraintApplicationAttribute meth.Method + let noEagerConstraintApplication = MethInfoHasWellKnownAttribute g m WellKnownILAttributes.NoEagerConstraintApplicationAttribute WellKnownValAttributes.None g.attrib_NoEagerConstraintApplicationAttribute meth.Method // The logic associated with NoEagerConstraintApplicationAttribute is part of the // Tasks and Resumable Code RFC diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 3ea2a6c33ba..5348468127d 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -543,7 +543,7 @@ let IsMethInfoPlainCSharpStyleExtensionMember g m isEnclExtTy (minfo: MethInfo) not minfo.IsInstance && not minfo.IsExtensionMember && (match minfo.NumArgs with [x] when x >= 1 -> true | _ -> false) && - MethInfoHasAttribute g m g.attrib_ExtensionAttribute minfo + MethInfoHasWellKnownAttribute g m WellKnownILAttributes.ExtensionAttribute WellKnownValAttributes.ExtensionAttribute g.attrib_ExtensionAttribute minfo let GetTyconRefForExtensionMembers minfo (deref: Entity) amap m g = try diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 79343fd96d3..ecb27e1bf97 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -1496,7 +1496,6 @@ type TcGlobals( member val attrib_DefaultValueAttribute = mk_MFCore_attrib "DefaultValueAttribute" - member val attrib_StructAttribute = mk_MFCore_attrib "StructAttribute" member val attrib_ReflectedDefinitionAttribute = mk_MFCore_attrib "ReflectedDefinitionAttribute" member val attrib_CompiledNameAttribute = mk_MFCore_attrib "CompiledNameAttribute" member val attrib_AutoOpenAttribute = mk_MFCore_attrib "AutoOpenAttribute" diff --git a/src/Compiler/TypedTree/TcGlobals.fsi b/src/Compiler/TypedTree/TcGlobals.fsi index 6e0ba91cacb..74014373e82 100644 --- a/src/Compiler/TypedTree/TcGlobals.fsi +++ b/src/Compiler/TypedTree/TcGlobals.fsi @@ -408,11 +408,6 @@ type internal TcGlobals = member attrib_DecimalConstantAttribute: BuiltinAttribInfo - member attrib_StructAttribute: BuiltinAttribInfo - - - - member attrib_SystemObsolete: BuiltinAttribInfo member attrib_IsByRefLikeAttribute_opt: BuiltinAttribInfo option From 5338bf306dbbd1241d65f3456a155722c70f9852 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 2 Mar 2026 17:25:44 +0100 Subject: [PATCH 54/71] Council fixes: resolveAttribPath DU, merge IL maps, private HasWellKnownAttribute, cleanup MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - Refactor resolveAttribPath from callback to struct(bclPath, fsharpCorePath) return value. Eliminates mutable-captured-by-closure in all 3 classifiers, removes 1 nesting level, makes control flow linear and purely functional. - Merge mapILFlagToAttribInfo + mapILFlagToEntityFlag into single mapILFlag returning struct(EntityFlag * AttribInfo option). One match, no drift risk. - Remove HasWellKnownAttribute from .fsi — callers must use CheckFlag. - Remove dead _g parameter from CheckCompilerFeatureRequiredAttribute. - Add NoEagerConstraintApplicationAttribute to WellKnownValAttributes for complete MethInfoHasWellKnownAttribute coverage on FSMeth path. - Add comment on dual-namespace SetsRequiredMembersAttribute. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/AttributeChecking.fs | 4 +- .../Checking/Expressions/CheckExpressions.fs | 2 +- src/Compiler/Checking/MethodCalls.fs | 2 +- src/Compiler/TypedTree/TypedTreeOps.fs | 407 ++++++++---------- src/Compiler/TypedTree/TypedTreeOps.fsi | 4 +- src/Compiler/TypedTree/WellKnownAttribs.fs | 1 + src/Compiler/TypedTree/WellKnownAttribs.fsi | 2 +- 7 files changed, 197 insertions(+), 225 deletions(-) diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index e273d0ce566..98c9eb95de8 100755 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -243,7 +243,7 @@ let rec MethInfoHasWellKnownAttribute g (m: range) (ilFlag: WellKnownILAttribute | ProvidedMeth _ -> MethInfoHasAttribute g m attribSpec minfo #endif -let private CheckCompilerFeatureRequiredAttribute (_g: TcGlobals) cattrs msg m = +let private CheckCompilerFeatureRequiredAttribute cattrs msg m = // In some cases C# will generate both ObsoleteAttribute and CompilerFeatureRequiredAttribute. // Specifically, when default constructor is generated for class with any required members in them. // ObsoleteAttribute should be ignored if CompilerFeatureRequiredAttribute is present, and its name is "RequiredMembers". @@ -314,7 +314,7 @@ let private CheckILObsoleteAttributes (g: TcGlobals) isByrefLikeTyconRef cattrs let diagnosticId, urlFormat = extractILAttributeInfo namedArgs if isError then if g.langVersion.SupportsFeature(LanguageFeature.RequiredPropertiesSupport) then - CheckCompilerFeatureRequiredAttribute g cattrs msg m + CheckCompilerFeatureRequiredAttribute cattrs msg m else ErrorD (ObsoleteDiagnostic(true, diagnosticId, msg, urlFormat, m)) else diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 52e7c885cff..c50f7b40e9a 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -10228,7 +10228,7 @@ and TcMethodApplication_CheckArguments | Some (unnamedInfo, namedInfo) -> let calledObjArgTys = meth.CalledObjArgTys mMethExpr if (calledObjArgTys, callerObjArgTys) ||> Seq.forall2 (fun calledTy callerTy -> - let noEagerConstraintApplication = MethInfoHasWellKnownAttribute g mMethExpr WellKnownILAttributes.NoEagerConstraintApplicationAttribute WellKnownValAttributes.None g.attrib_NoEagerConstraintApplicationAttribute meth.Method + let noEagerConstraintApplication = MethInfoHasWellKnownAttribute g mMethExpr WellKnownILAttributes.NoEagerConstraintApplicationAttribute WellKnownValAttributes.NoEagerConstraintApplicationAttribute g.attrib_NoEagerConstraintApplicationAttribute meth.Method // The logic associated with NoEagerConstraintApplicationAttribute is part of the // Tasks and Resumable Code RFC diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 54690913f1d..2ea041144ad 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -918,7 +918,7 @@ let ExamineArgumentForLambdaPropagation (infoReader: InfoReader) ad noEagerConst CalledArgMatchesType(adjustedCalledArgTy, noEagerConstraintApplication) let ExamineMethodForLambdaPropagation (g: TcGlobals) m (meth: CalledMeth) ad = - let noEagerConstraintApplication = MethInfoHasWellKnownAttribute g m WellKnownILAttributes.NoEagerConstraintApplicationAttribute WellKnownValAttributes.None g.attrib_NoEagerConstraintApplicationAttribute meth.Method + let noEagerConstraintApplication = MethInfoHasWellKnownAttribute g m WellKnownILAttributes.NoEagerConstraintApplicationAttribute WellKnownValAttributes.NoEagerConstraintApplicationAttribute g.attrib_NoEagerConstraintApplicationAttribute meth.Method // The logic associated with NoEagerConstraintApplicationAttribute is part of the // Tasks and Resumable Code RFC diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index d72759a7d01..a6fc85a0612 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3629,6 +3629,7 @@ let classifyILAttrib (attr: ILAttribute) : WellKnownILAttributes = | "System.ParamArrayAttribute" -> WellKnownILAttributes.ParamArrayAttribute | "System.Reflection.DefaultMemberAttribute" -> WellKnownILAttributes.DefaultMemberAttribute | "System.Diagnostics.CodeAnalysis.SetsRequiredMembersAttribute" -> + // Also at System.Runtime.CompilerServices (line above); .NET defines it in both namespaces WellKnownILAttributes.SetsRequiredMembersAttribute | "System.ObsoleteAttribute" -> WellKnownILAttributes.ObsoleteAttribute | "System.Diagnostics.CodeAnalysis.ExperimentalAttribute" -> WellKnownILAttributes.ExperimentalAttribute @@ -3684,22 +3685,21 @@ type ILAttributes with x.AsArray() |> Array.exists (fun attr -> classifyILAttrib attr &&& flag <> WellKnownILAttributes.None) /// Resolve the FSharp.Core path for an attribute's type reference. -/// Returns ValueSome path for FSharp.Core attributes, calls bclDispatch for BCL attributes, ValueNone otherwise. -let inline resolveAttribPath (g: TcGlobals) (tcref: TyconRef) (bclDispatch: string[] -> unit) : string[] voption = +/// Returns struct(bclPath, fsharpCorePath). Exactly one will be ValueSome, or both ValueNone. +let inline resolveAttribPath (g: TcGlobals) (tcref: TyconRef) : struct (string[] voption * string[] voption) = if not tcref.IsLocalRef then let nlr = tcref.nlr if ccuEq nlr.Ccu g.fslibCcu then - ValueSome nlr.Path + struct (ValueNone, ValueSome nlr.Path) else - bclDispatch nlr.Path - ValueNone + struct (ValueSome nlr.Path, ValueNone) elif g.compilingFSharpCore then match tcref.Deref.PublicPath with - | Some(PubPath pp) -> ValueSome pp - | None -> ValueNone + | Some(PubPath pp) -> struct (ValueNone, ValueSome pp) + | None -> struct (ValueNone, ValueNone) else - ValueNone + struct (ValueNone, ValueNone) /// Decode a bool-arg attribute and set the appropriate true/false flag. let inline decodeBoolAttribFlag (attrib: Attrib) trueFlag falseFlag defaultFlag = @@ -3710,57 +3710,49 @@ let inline decodeBoolAttribFlag (attrib: Attrib) trueFlag falseFlag defaultFlag /// Classify a single Entity-level attribute, returning its well-known flag (or None). let classifyEntityAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownEntityAttributes = let (Attrib(tcref, _, _, _, _, _, _)) = attrib - let mutable flag = WellKnownEntityAttributes.None - - let fsharpCorePath = - resolveAttribPath g tcref (fun path -> - match path with - | [| "System"; "Runtime"; "CompilerServices"; name |] -> - match name with - | "ExtensionAttribute" -> flag <- WellKnownEntityAttributes.ExtensionAttribute - | "IsReadOnlyAttribute" -> flag <- WellKnownEntityAttributes.IsReadOnlyAttribute - | "SkipLocalsInitAttribute" -> flag <- WellKnownEntityAttributes.SkipLocalsInitAttribute - | "IsByRefLikeAttribute" -> flag <- WellKnownEntityAttributes.IsByRefLikeAttribute - | _ -> () - - | [| "System"; "Runtime"; "InteropServices"; name |] -> - match name with - | "StructLayoutAttribute" -> flag <- WellKnownEntityAttributes.StructLayoutAttribute - | "DllImportAttribute" -> flag <- WellKnownEntityAttributes.DllImportAttribute - | "ComVisibleAttribute" -> - flag <- - decodeBoolAttribFlag - attrib - WellKnownEntityAttributes.ComVisibleAttribute_True - WellKnownEntityAttributes.ComVisibleAttribute_False - WellKnownEntityAttributes.ComVisibleAttribute_True - | "ComImportAttribute" -> - flag <- - decodeBoolAttribFlag - attrib - WellKnownEntityAttributes.ComImportAttribute_True - WellKnownEntityAttributes.None - WellKnownEntityAttributes.ComImportAttribute_True - | _ -> () - - | [| "System"; "Diagnostics"; name |] -> - match name with - | "DebuggerDisplayAttribute" -> flag <- WellKnownEntityAttributes.DebuggerDisplayAttribute - | "DebuggerTypeProxyAttribute" -> flag <- WellKnownEntityAttributes.DebuggerTypeProxyAttribute - | _ -> () - - | [| "System"; "ComponentModel"; name |] -> - match name with - | "EditorBrowsableAttribute" -> flag <- WellKnownEntityAttributes.EditorBrowsableAttribute - | _ -> () - - | [| "System"; name |] -> - match name with - | "AttributeUsageAttribute" -> flag <- WellKnownEntityAttributes.AttributeUsageAttribute - | "ObsoleteAttribute" -> flag <- WellKnownEntityAttributes.ObsoleteAttribute - | _ -> () - - | _ -> ()) + let struct (bclPath, fsharpCorePath) = resolveAttribPath g tcref + + match bclPath with + | ValueSome path -> + match path with + | [| "System"; "Runtime"; "CompilerServices"; name |] -> + match name with + | "ExtensionAttribute" -> WellKnownEntityAttributes.ExtensionAttribute + | "IsReadOnlyAttribute" -> WellKnownEntityAttributes.IsReadOnlyAttribute + | "SkipLocalsInitAttribute" -> WellKnownEntityAttributes.SkipLocalsInitAttribute + | "IsByRefLikeAttribute" -> WellKnownEntityAttributes.IsByRefLikeAttribute + | _ -> WellKnownEntityAttributes.None + + | [| "System"; "Runtime"; "InteropServices"; name |] -> + match name with + | "StructLayoutAttribute" -> WellKnownEntityAttributes.StructLayoutAttribute + | "DllImportAttribute" -> WellKnownEntityAttributes.DllImportAttribute + | "ComVisibleAttribute" -> + decodeBoolAttribFlag attrib WellKnownEntityAttributes.ComVisibleAttribute_True WellKnownEntityAttributes.ComVisibleAttribute_False WellKnownEntityAttributes.ComVisibleAttribute_True + | "ComImportAttribute" -> + decodeBoolAttribFlag attrib WellKnownEntityAttributes.ComImportAttribute_True WellKnownEntityAttributes.None WellKnownEntityAttributes.ComImportAttribute_True + | _ -> WellKnownEntityAttributes.None + + | [| "System"; "Diagnostics"; name |] -> + match name with + | "DebuggerDisplayAttribute" -> WellKnownEntityAttributes.DebuggerDisplayAttribute + | "DebuggerTypeProxyAttribute" -> WellKnownEntityAttributes.DebuggerTypeProxyAttribute + | _ -> WellKnownEntityAttributes.None + + | [| "System"; "ComponentModel"; name |] -> + match name with + | "EditorBrowsableAttribute" -> WellKnownEntityAttributes.EditorBrowsableAttribute + | _ -> WellKnownEntityAttributes.None + + | [| "System"; name |] -> + match name with + | "AttributeUsageAttribute" -> WellKnownEntityAttributes.AttributeUsageAttribute + | "ObsoleteAttribute" -> WellKnownEntityAttributes.ObsoleteAttribute + | _ -> WellKnownEntityAttributes.None + + | _ -> WellKnownEntityAttributes.None + + | ValueNone -> match fsharpCorePath with | ValueSome path -> @@ -3768,94 +3760,83 @@ let classifyEntityAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownEntityAttrib | [| "Microsoft"; "FSharp"; "Core"; name |] -> match name with | "SealedAttribute" -> - flag <- - decodeBoolAttribFlag - attrib - WellKnownEntityAttributes.SealedAttribute_True - WellKnownEntityAttributes.SealedAttribute_False - WellKnownEntityAttributes.SealedAttribute_True - | "AbstractClassAttribute" -> flag <- WellKnownEntityAttributes.AbstractClassAttribute - | "RequireQualifiedAccessAttribute" -> flag <- WellKnownEntityAttributes.RequireQualifiedAccessAttribute - | "AutoOpenAttribute" -> flag <- WellKnownEntityAttributes.AutoOpenAttribute - | "NoEqualityAttribute" -> flag <- WellKnownEntityAttributes.NoEqualityAttribute - | "NoComparisonAttribute" -> flag <- WellKnownEntityAttributes.NoComparisonAttribute - | "StructuralEqualityAttribute" -> flag <- WellKnownEntityAttributes.StructuralEqualityAttribute - | "StructuralComparisonAttribute" -> flag <- WellKnownEntityAttributes.StructuralComparisonAttribute - | "CustomEqualityAttribute" -> flag <- WellKnownEntityAttributes.CustomEqualityAttribute - | "CustomComparisonAttribute" -> flag <- WellKnownEntityAttributes.CustomComparisonAttribute - | "ReferenceEqualityAttribute" -> flag <- WellKnownEntityAttributes.ReferenceEqualityAttribute + decodeBoolAttribFlag attrib WellKnownEntityAttributes.SealedAttribute_True WellKnownEntityAttributes.SealedAttribute_False WellKnownEntityAttributes.SealedAttribute_True + | "AbstractClassAttribute" -> WellKnownEntityAttributes.AbstractClassAttribute + | "RequireQualifiedAccessAttribute" -> WellKnownEntityAttributes.RequireQualifiedAccessAttribute + | "AutoOpenAttribute" -> WellKnownEntityAttributes.AutoOpenAttribute + | "NoEqualityAttribute" -> WellKnownEntityAttributes.NoEqualityAttribute + | "NoComparisonAttribute" -> WellKnownEntityAttributes.NoComparisonAttribute + | "StructuralEqualityAttribute" -> WellKnownEntityAttributes.StructuralEqualityAttribute + | "StructuralComparisonAttribute" -> WellKnownEntityAttributes.StructuralComparisonAttribute + | "CustomEqualityAttribute" -> WellKnownEntityAttributes.CustomEqualityAttribute + | "CustomComparisonAttribute" -> WellKnownEntityAttributes.CustomComparisonAttribute + | "ReferenceEqualityAttribute" -> WellKnownEntityAttributes.ReferenceEqualityAttribute | "DefaultAugmentationAttribute" -> - flag <- decodeBoolAttribFlag attrib WellKnownEntityAttributes.DefaultAugmentationAttribute_True WellKnownEntityAttributes.DefaultAugmentationAttribute_False WellKnownEntityAttributes.DefaultAugmentationAttribute_True - | "CLIMutableAttribute" -> flag <- WellKnownEntityAttributes.CLIMutableAttribute + decodeBoolAttribFlag attrib WellKnownEntityAttributes.DefaultAugmentationAttribute_True WellKnownEntityAttributes.DefaultAugmentationAttribute_False WellKnownEntityAttributes.DefaultAugmentationAttribute_True + | "CLIMutableAttribute" -> WellKnownEntityAttributes.CLIMutableAttribute | "AutoSerializableAttribute" -> - flag <- decodeBoolAttribFlag attrib WellKnownEntityAttributes.AutoSerializableAttribute_True WellKnownEntityAttributes.AutoSerializableAttribute_False WellKnownEntityAttributes.AutoSerializableAttribute_True - | "ReflectedDefinitionAttribute" -> flag <- WellKnownEntityAttributes.ReflectedDefinitionAttribute + decodeBoolAttribFlag attrib WellKnownEntityAttributes.AutoSerializableAttribute_True WellKnownEntityAttributes.AutoSerializableAttribute_False WellKnownEntityAttributes.AutoSerializableAttribute_True + | "ReflectedDefinitionAttribute" -> WellKnownEntityAttributes.ReflectedDefinitionAttribute | "AllowNullLiteralAttribute" -> - flag <- - decodeBoolAttribFlag - attrib - WellKnownEntityAttributes.AllowNullLiteralAttribute_True - WellKnownEntityAttributes.AllowNullLiteralAttribute_False - WellKnownEntityAttributes.AllowNullLiteralAttribute_True - | "WarnOnWithoutNullArgumentAttribute" -> flag <- WellKnownEntityAttributes.WarnOnWithoutNullArgumentAttribute - | "ClassAttribute" -> flag <- WellKnownEntityAttributes.ClassAttribute - | "InterfaceAttribute" -> flag <- WellKnownEntityAttributes.InterfaceAttribute - | "StructAttribute" -> flag <- WellKnownEntityAttributes.StructAttribute - | "MeasureAttribute" -> flag <- WellKnownEntityAttributes.MeasureAttribute - | "MeasureAnnotatedAbbreviationAttribute" -> flag <- WellKnownEntityAttributes.MeasureableAttribute - | "CLIEventAttribute" -> flag <- WellKnownEntityAttributes.CLIEventAttribute - | "CompilerMessageAttribute" -> flag <- WellKnownEntityAttributes.CompilerMessageAttribute - | "ExperimentalAttribute" -> flag <- WellKnownEntityAttributes.ExperimentalAttribute - | "UnverifiableAttribute" -> flag <- WellKnownEntityAttributes.UnverifiableAttribute - | "CompiledNameAttribute" -> flag <- WellKnownEntityAttributes.CompiledNameAttribute + decodeBoolAttribFlag attrib WellKnownEntityAttributes.AllowNullLiteralAttribute_True WellKnownEntityAttributes.AllowNullLiteralAttribute_False WellKnownEntityAttributes.AllowNullLiteralAttribute_True + | "WarnOnWithoutNullArgumentAttribute" -> WellKnownEntityAttributes.WarnOnWithoutNullArgumentAttribute + | "ClassAttribute" -> WellKnownEntityAttributes.ClassAttribute + | "InterfaceAttribute" -> WellKnownEntityAttributes.InterfaceAttribute + | "StructAttribute" -> WellKnownEntityAttributes.StructAttribute + | "MeasureAttribute" -> WellKnownEntityAttributes.MeasureAttribute + | "MeasureAnnotatedAbbreviationAttribute" -> WellKnownEntityAttributes.MeasureableAttribute + | "CLIEventAttribute" -> WellKnownEntityAttributes.CLIEventAttribute + | "CompilerMessageAttribute" -> WellKnownEntityAttributes.CompilerMessageAttribute + | "ExperimentalAttribute" -> WellKnownEntityAttributes.ExperimentalAttribute + | "UnverifiableAttribute" -> WellKnownEntityAttributes.UnverifiableAttribute + | "CompiledNameAttribute" -> WellKnownEntityAttributes.CompiledNameAttribute | "CompilationRepresentationAttribute" -> match attrib with | Attrib(_, _, [ AttribInt32Arg v ], _, _, _, _) -> + let mutable flags = WellKnownEntityAttributes.None if v &&& 0x01 <> 0 then - flag <- flag ||| WellKnownEntityAttributes.CompilationRepresentation_Static + flags <- flags ||| WellKnownEntityAttributes.CompilationRepresentation_Static if v &&& 0x02 <> 0 then - flag <- flag ||| WellKnownEntityAttributes.CompilationRepresentation_Instance + flags <- flags ||| WellKnownEntityAttributes.CompilationRepresentation_Instance if v &&& 0x04 <> 0 then - flag <- flag ||| WellKnownEntityAttributes.CompilationRepresentation_ModuleSuffix + flags <- flags ||| WellKnownEntityAttributes.CompilationRepresentation_ModuleSuffix if v &&& 0x08 <> 0 then - flag <- flag ||| WellKnownEntityAttributes.CompilationRepresentation_PermitNull - | _ -> () - | _ -> () - | _ -> () - | ValueNone -> () - - flag + flags <- flags ||| WellKnownEntityAttributes.CompilationRepresentation_PermitNull + flags + | _ -> WellKnownEntityAttributes.None + | _ -> WellKnownEntityAttributes.None + | _ -> WellKnownEntityAttributes.None + | ValueNone -> WellKnownEntityAttributes.None /// Classify a single assembly-level attribute, returning its well-known flag (or None). let classifyAssemblyAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownAssemblyAttributes = let (Attrib(tcref, _, _, _, _, _, _)) = attrib - let mutable flag = WellKnownAssemblyAttributes.None - - let fsharpCorePath = - resolveAttribPath g tcref (fun path -> - match path with - | [| "System"; "Runtime"; "CompilerServices"; name |] -> - match name with - | "InternalsVisibleToAttribute" -> flag <- WellKnownAssemblyAttributes.InternalsVisibleToAttribute - | _ -> () - | [| "System"; "Reflection"; name |] -> - match name with - | "AssemblyCultureAttribute" -> flag <- WellKnownAssemblyAttributes.AssemblyCultureAttribute - | "AssemblyVersionAttribute" -> flag <- WellKnownAssemblyAttributes.AssemblyVersionAttribute - | _ -> () - | _ -> ()) + let struct (bclPath, fsharpCorePath) = resolveAttribPath g tcref + + match bclPath with + | ValueSome path -> + match path with + | [| "System"; "Runtime"; "CompilerServices"; name |] -> + match name with + | "InternalsVisibleToAttribute" -> WellKnownAssemblyAttributes.InternalsVisibleToAttribute + | _ -> WellKnownAssemblyAttributes.None + | [| "System"; "Reflection"; name |] -> + match name with + | "AssemblyCultureAttribute" -> WellKnownAssemblyAttributes.AssemblyCultureAttribute + | "AssemblyVersionAttribute" -> WellKnownAssemblyAttributes.AssemblyVersionAttribute + | _ -> WellKnownAssemblyAttributes.None + | _ -> WellKnownAssemblyAttributes.None + | ValueNone -> match fsharpCorePath with | ValueSome path -> match path with | [| "Microsoft"; "FSharp"; "Core"; name |] -> match name with - | "AutoOpenAttribute" -> flag <- WellKnownAssemblyAttributes.AutoOpenAttribute - | _ -> () - | _ -> () - | ValueNone -> () - - flag + | "AutoOpenAttribute" -> WellKnownAssemblyAttributes.AutoOpenAttribute + | _ -> WellKnownAssemblyAttributes.None + | _ -> WellKnownAssemblyAttributes.None + | ValueNone -> WellKnownAssemblyAttributes.None /// Shared combinator: find first attrib matching a flag via a classify function. let inline internal tryFindAttribByClassifier ([] classify: TcGlobals -> Attrib -> 'Flag) (none: 'Flag) (g: TcGlobals) (flag: 'Flag) (attribs: Attribs) : Attrib option = @@ -3906,33 +3887,17 @@ let (|AssemblyAttribString|_|) (g: TcGlobals) (flag: WellKnownAssemblyAttributes | Some(Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> ValueSome s | _ -> ValueNone -#if !NO_TYPEPROVIDERS -/// Map a WellKnownILAttributes flag to its AttribInfo equivalent. -let mapILFlagToAttribInfo (g: TcGlobals) (flag: WellKnownILAttributes) : BuiltinAttribInfo option = +/// Map a WellKnownILAttributes flag to its entity flag + provided-type AttribInfo equivalents. +let mapILFlag (g: TcGlobals) (flag: WellKnownILAttributes) : struct (WellKnownEntityAttributes * BuiltinAttribInfo option) = match flag with - | WellKnownILAttributes.IsReadOnlyAttribute -> Some g.attrib_IsReadOnlyAttribute - | WellKnownILAttributes.IsByRefLikeAttribute -> g.attrib_IsByRefLikeAttribute_opt - | WellKnownILAttributes.ExtensionAttribute -> Some g.attrib_ExtensionAttribute - | WellKnownILAttributes.AllowNullLiteralAttribute -> Some g.attrib_AllowNullLiteralAttribute - | WellKnownILAttributes.AutoOpenAttribute -> Some g.attrib_AutoOpenAttribute - | WellKnownILAttributes.ReflectedDefinitionAttribute -> Some g.attrib_ReflectedDefinitionAttribute - | _ -> None -#endif - -/// Map a WellKnownILAttributes flag to its WellKnownEntityAttributes equivalent. -/// Used for hybrid check sites that dispatch on IL vs F# metadata. -let mapILFlagToEntityFlag (flag: WellKnownILAttributes) : WellKnownEntityAttributes = - match flag with - | WellKnownILAttributes.IsReadOnlyAttribute -> WellKnownEntityAttributes.IsReadOnlyAttribute - | WellKnownILAttributes.IsByRefLikeAttribute -> WellKnownEntityAttributes.IsByRefLikeAttribute - | WellKnownILAttributes.ExtensionAttribute -> WellKnownEntityAttributes.ExtensionAttribute - | WellKnownILAttributes.AllowNullLiteralAttribute -> WellKnownEntityAttributes.AllowNullLiteralAttribute_True - | WellKnownILAttributes.AutoOpenAttribute -> WellKnownEntityAttributes.AutoOpenAttribute - | WellKnownILAttributes.ReflectedDefinitionAttribute -> WellKnownEntityAttributes.ReflectedDefinitionAttribute - | WellKnownILAttributes.ObsoleteAttribute -> WellKnownEntityAttributes.ObsoleteAttribute - | WellKnownILAttributes.DefaultMemberAttribute -> WellKnownEntityAttributes.None - | WellKnownILAttributes.NoEagerConstraintApplicationAttribute -> WellKnownEntityAttributes.None - | _ -> WellKnownEntityAttributes.None + | WellKnownILAttributes.IsReadOnlyAttribute -> struct (WellKnownEntityAttributes.IsReadOnlyAttribute, Some g.attrib_IsReadOnlyAttribute) + | WellKnownILAttributes.IsByRefLikeAttribute -> struct (WellKnownEntityAttributes.IsByRefLikeAttribute, g.attrib_IsByRefLikeAttribute_opt) + | WellKnownILAttributes.ExtensionAttribute -> struct (WellKnownEntityAttributes.ExtensionAttribute, Some g.attrib_ExtensionAttribute) + | WellKnownILAttributes.AllowNullLiteralAttribute -> struct (WellKnownEntityAttributes.AllowNullLiteralAttribute_True, Some g.attrib_AllowNullLiteralAttribute) + | WellKnownILAttributes.AutoOpenAttribute -> struct (WellKnownEntityAttributes.AutoOpenAttribute, Some g.attrib_AutoOpenAttribute) + | WellKnownILAttributes.ReflectedDefinitionAttribute -> struct (WellKnownEntityAttributes.ReflectedDefinitionAttribute, Some g.attrib_ReflectedDefinitionAttribute) + | WellKnownILAttributes.ObsoleteAttribute -> struct (WellKnownEntityAttributes.ObsoleteAttribute, None) + | _ -> struct (WellKnownEntityAttributes.None, None) /// Check if a raw attribute list has a specific well-known entity flag (ad-hoc, non-caching). let attribsHaveEntityFlag g (flag: WellKnownEntityAttributes) (attribs: Attribs) = @@ -3949,77 +3914,81 @@ let EntityHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownEntityAttributes) /// Classify a single Val-level attribute, returning its well-known flag (or None). let classifyValAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownValAttributes = let (Attrib(tcref, _, _, _, _, _, _)) = attrib - let mutable flag = WellKnownValAttributes.None - - let fsharpCorePath = - resolveAttribPath g tcref (fun path -> - match path with - | [| "System"; "Runtime"; "CompilerServices"; name |] -> - match name with - | "SkipLocalsInitAttribute" -> flag <- WellKnownValAttributes.SkipLocalsInitAttribute - | "ExtensionAttribute" -> flag <- WellKnownValAttributes.ExtensionAttribute - | "CallerMemberNameAttribute" -> flag <- WellKnownValAttributes.CallerMemberNameAttribute - | "CallerFilePathAttribute" -> flag <- WellKnownValAttributes.CallerFilePathAttribute - | "CallerLineNumberAttribute" -> flag <- WellKnownValAttributes.CallerLineNumberAttribute - | "MethodImplAttribute" -> flag <- WellKnownValAttributes.MethodImplAttribute - | _ -> () - - | [| "System"; "Runtime"; "InteropServices"; name |] -> - match name with - | "DllImportAttribute" -> flag <- WellKnownValAttributes.DllImportAttribute - | "InAttribute" -> flag <- WellKnownValAttributes.InAttribute - | "OutAttribute" -> flag <- WellKnownValAttributes.OutAttribute - | "MarshalAsAttribute" -> flag <- WellKnownValAttributes.MarshalAsAttribute - | "DefaultParameterValueAttribute" -> flag <- WellKnownValAttributes.DefaultParameterValueAttribute - | "OptionalAttribute" -> flag <- WellKnownValAttributes.OptionalAttribute - | "PreserveSigAttribute" -> flag <- WellKnownValAttributes.PreserveSigAttribute - | "FieldOffsetAttribute" -> flag <- WellKnownValAttributes.FieldOffsetAttribute - | _ -> () - - | [| "System"; "Diagnostics"; name |] -> - match name with - | "ConditionalAttribute" -> flag <- WellKnownValAttributes.ConditionalAttribute - | _ -> () - - | [| "System"; name |] -> - match name with - | "ThreadStaticAttribute" -> flag <- WellKnownValAttributes.ThreadStaticAttribute - | "ContextStaticAttribute" -> flag <- WellKnownValAttributes.ContextStaticAttribute - | "ParamArrayAttribute" -> flag <- WellKnownValAttributes.ParamArrayAttribute - | "NonSerializedAttribute" -> flag <- WellKnownValAttributes.NonSerializedAttribute - | _ -> () - - | _ -> ()) + let struct (bclPath, fsharpCorePath) = resolveAttribPath g tcref + + match bclPath with + | ValueSome path -> + match path with + | [| "System"; "Runtime"; "CompilerServices"; name |] -> + match name with + | "SkipLocalsInitAttribute" -> WellKnownValAttributes.SkipLocalsInitAttribute + | "ExtensionAttribute" -> WellKnownValAttributes.ExtensionAttribute + | "CallerMemberNameAttribute" -> WellKnownValAttributes.CallerMemberNameAttribute + | "CallerFilePathAttribute" -> WellKnownValAttributes.CallerFilePathAttribute + | "CallerLineNumberAttribute" -> WellKnownValAttributes.CallerLineNumberAttribute + | "MethodImplAttribute" -> WellKnownValAttributes.MethodImplAttribute + | _ -> WellKnownValAttributes.None + + | [| "System"; "Runtime"; "InteropServices"; name |] -> + match name with + | "DllImportAttribute" -> WellKnownValAttributes.DllImportAttribute + | "InAttribute" -> WellKnownValAttributes.InAttribute + | "OutAttribute" -> WellKnownValAttributes.OutAttribute + | "MarshalAsAttribute" -> WellKnownValAttributes.MarshalAsAttribute + | "DefaultParameterValueAttribute" -> WellKnownValAttributes.DefaultParameterValueAttribute + | "OptionalAttribute" -> WellKnownValAttributes.OptionalAttribute + | "PreserveSigAttribute" -> WellKnownValAttributes.PreserveSigAttribute + | "FieldOffsetAttribute" -> WellKnownValAttributes.FieldOffsetAttribute + | _ -> WellKnownValAttributes.None + + | [| "System"; "Diagnostics"; name |] -> + match name with + | "ConditionalAttribute" -> WellKnownValAttributes.ConditionalAttribute + | _ -> WellKnownValAttributes.None + + | [| "System"; name |] -> + match name with + | "ThreadStaticAttribute" -> WellKnownValAttributes.ThreadStaticAttribute + | "ContextStaticAttribute" -> WellKnownValAttributes.ContextStaticAttribute + | "ParamArrayAttribute" -> WellKnownValAttributes.ParamArrayAttribute + | "NonSerializedAttribute" -> WellKnownValAttributes.NonSerializedAttribute + | _ -> WellKnownValAttributes.None + + | _ -> WellKnownValAttributes.None + + | ValueNone -> match fsharpCorePath with | ValueSome path -> match path with | [| "Microsoft"; "FSharp"; "Core"; name |] -> match name with - | "EntryPointAttribute" -> flag <- WellKnownValAttributes.EntryPointAttribute - | "LiteralAttribute" -> flag <- WellKnownValAttributes.LiteralAttribute + | "EntryPointAttribute" -> WellKnownValAttributes.EntryPointAttribute + | "LiteralAttribute" -> WellKnownValAttributes.LiteralAttribute | "ReflectedDefinitionAttribute" -> - flag <- decodeBoolAttribFlag attrib WellKnownValAttributes.ReflectedDefinitionAttribute_True WellKnownValAttributes.ReflectedDefinitionAttribute_False WellKnownValAttributes.ReflectedDefinitionAttribute_False - | "RequiresExplicitTypeArgumentsAttribute" -> flag <- WellKnownValAttributes.RequiresExplicitTypeArgumentsAttribute + decodeBoolAttribFlag attrib WellKnownValAttributes.ReflectedDefinitionAttribute_True WellKnownValAttributes.ReflectedDefinitionAttribute_False WellKnownValAttributes.ReflectedDefinitionAttribute_False + | "RequiresExplicitTypeArgumentsAttribute" -> WellKnownValAttributes.RequiresExplicitTypeArgumentsAttribute | "DefaultValueAttribute" -> - flag <- decodeBoolAttribFlag attrib WellKnownValAttributes.DefaultValueAttribute_True WellKnownValAttributes.DefaultValueAttribute_False WellKnownValAttributes.DefaultValueAttribute_True - | "VolatileFieldAttribute" -> flag <- WellKnownValAttributes.VolatileFieldAttribute + decodeBoolAttribFlag attrib WellKnownValAttributes.DefaultValueAttribute_True WellKnownValAttributes.DefaultValueAttribute_False WellKnownValAttributes.DefaultValueAttribute_True + | "VolatileFieldAttribute" -> WellKnownValAttributes.VolatileFieldAttribute | "NoDynamicInvocationAttribute" -> - flag <- decodeBoolAttribFlag attrib WellKnownValAttributes.NoDynamicInvocationAttribute_True WellKnownValAttributes.NoDynamicInvocationAttribute_False WellKnownValAttributes.NoDynamicInvocationAttribute_False - | "OptionalArgumentAttribute" -> flag <- WellKnownValAttributes.OptionalArgumentAttribute - | "ProjectionParameterAttribute" -> flag <- WellKnownValAttributes.ProjectionParameterAttribute - | "InlineIfLambdaAttribute" -> flag <- WellKnownValAttributes.InlineIfLambdaAttribute - | "StructAttribute" -> flag <- WellKnownValAttributes.StructAttribute - | "NoCompilerInliningAttribute" -> flag <- WellKnownValAttributes.NoCompilerInliningAttribute - | "GeneralizableValueAttribute" -> flag <- WellKnownValAttributes.GeneralizableValueAttribute - | "CLIEventAttribute" -> flag <- WellKnownValAttributes.CLIEventAttribute - | "CompiledNameAttribute" -> flag <- WellKnownValAttributes.CompiledNameAttribute - | "WarnOnWithoutNullArgumentAttribute" -> flag <- WellKnownValAttributes.WarnOnWithoutNullArgumentAttribute - | _ -> () - | _ -> () - | ValueNone -> () - - flag + decodeBoolAttribFlag attrib WellKnownValAttributes.NoDynamicInvocationAttribute_True WellKnownValAttributes.NoDynamicInvocationAttribute_False WellKnownValAttributes.NoDynamicInvocationAttribute_False + | "OptionalArgumentAttribute" -> WellKnownValAttributes.OptionalArgumentAttribute + | "ProjectionParameterAttribute" -> WellKnownValAttributes.ProjectionParameterAttribute + | "InlineIfLambdaAttribute" -> WellKnownValAttributes.InlineIfLambdaAttribute + | "StructAttribute" -> WellKnownValAttributes.StructAttribute + | "NoCompilerInliningAttribute" -> WellKnownValAttributes.NoCompilerInliningAttribute + | "GeneralizableValueAttribute" -> WellKnownValAttributes.GeneralizableValueAttribute + | "CLIEventAttribute" -> WellKnownValAttributes.CLIEventAttribute + | "CompiledNameAttribute" -> WellKnownValAttributes.CompiledNameAttribute + | "WarnOnWithoutNullArgumentAttribute" -> WellKnownValAttributes.WarnOnWithoutNullArgumentAttribute + | _ -> WellKnownValAttributes.None + | [| "Microsoft"; "FSharp"; "Core"; "CompilerServices"; name |] -> + match name with + | "NoEagerConstraintApplicationAttribute" -> WellKnownValAttributes.NoEagerConstraintApplicationAttribute + | _ -> WellKnownValAttributes.None + | _ -> WellKnownValAttributes.None + | ValueNone -> WellKnownValAttributes.None let computeValWellKnownFlags (g: TcGlobals) (attribs: Attribs) : WellKnownValAttributes = let mutable flags = WellKnownValAttributes.None @@ -4089,7 +4058,7 @@ let EntityTryGetBoolAttribute (g: TcGlobals) (trueFlag: WellKnownEntityAttribute Option.None else let ea = entity.EntityAttribs - if ea.HasWellKnownAttribute(trueFlag) then Some true + if hasFlag ea.Flags trueFlag then Some true else Some false /// Analyze three cases for attributes declared on type definitions: IL-declared attributes, F#-declared attributes and @@ -4164,13 +4133,15 @@ let TyconRefHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownILAttributes) ( match metadataOfTycon tcref.Deref with #if !NO_TYPEPROVIDERS | ProvidedTypeMetadata _ -> - match mapILFlagToAttribInfo g flag with + let struct (_, attribInfoOpt) = mapILFlag g flag + + match attribInfoOpt with | Some attribInfo -> TyconRefHasAttribute g tcref.Range attribInfo tcref | None -> false #endif | ILTypeMetadata(TILObjectReprData(_, _, tdef)) -> tdef.HasWellKnownAttribute(g, flag) | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> - let entityFlag = mapILFlagToEntityFlag flag + let struct (entityFlag, _) = mapILFlag g flag if entityFlag <> WellKnownEntityAttributes.None then EntityHasWellKnownAttribute g entityFlag tcref.Deref diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index b4114051b8d..5d97f6fbb23 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2458,8 +2458,8 @@ val (|ValAttribString|_|): g: TcGlobals -> flag: WellKnownValAttributes -> attri val EntityHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownEntityAttributes -> entity: Entity -> bool -/// Map a WellKnownILAttributes flag to its WellKnownEntityAttributes equivalent. -val mapILFlagToEntityFlag: flag: WellKnownILAttributes -> WellKnownEntityAttributes +/// Map a WellKnownILAttributes flag to its entity flag + provided-type AttribInfo equivalents. +val mapILFlag: g: TcGlobals -> flag: WellKnownILAttributes -> struct (WellKnownEntityAttributes * BuiltinAttribInfo option) val computeValWellKnownFlags: g: TcGlobals -> attribs: Attribs -> WellKnownValAttributes diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fs b/src/Compiler/TypedTree/WellKnownAttribs.fs index c3d19d16776..ce0a1f0737a 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fs +++ b/src/Compiler/TypedTree/WellKnownAttribs.fs @@ -112,6 +112,7 @@ type internal WellKnownValAttributes = | CompiledNameAttribute = (1uL <<< 35) | WarnOnWithoutNullArgumentAttribute = (1uL <<< 36) | MarshalAsAttribute = (1uL <<< 37) + | NoEagerConstraintApplicationAttribute = (1uL <<< 38) | NotComputed = (1uL <<< 63) /// Generic wrapper for an item list together with cached well-known attribute flags. diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fsi b/src/Compiler/TypedTree/WellKnownAttribs.fsi index ed98e06ce7f..121da64c2e1 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fsi +++ b/src/Compiler/TypedTree/WellKnownAttribs.fsi @@ -110,6 +110,7 @@ type internal WellKnownValAttributes = | CompiledNameAttribute = (1uL <<< 35) | WarnOnWithoutNullArgumentAttribute = (1uL <<< 36) | MarshalAsAttribute = (1uL <<< 37) + | NoEagerConstraintApplicationAttribute = (1uL <<< 38) | NotComputed = (1uL <<< 63) /// Generic wrapper for an item list together with cached well-known attribute flags. @@ -119,7 +120,6 @@ type internal WellKnownAttribs<'TItem, 'TFlags when 'TFlags: enum> = val private attribs: 'TItem list val private flags: 'TFlags new: attribs: 'TItem list * flags: 'TFlags -> WellKnownAttribs<'TItem, 'TFlags> - member HasWellKnownAttribute: flag: 'TFlags -> bool member AsList: unit -> 'TItem list member Flags: 'TFlags member Add: attrib: 'TItem * flag: 'TFlags -> WellKnownAttribs<'TItem, 'TFlags> From f666ca408ed0f18a4f8f070f4879aaca05a3c1cb Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Mon, 2 Mar 2026 18:08:15 +0100 Subject: [PATCH 55/71] Round 2 council fixes: extract WarnOnWithoutNull helper, dedup CheckILUnseen, tryGetAssemblyAttribString MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - Extract tryGetWarnOnWithoutNullMessage helper from duplicated 8-line decode logic at two CheckExpressions.fs callsites - CheckILAttributesForUnseen now uses ILAttributes.HasWellKnownAttribute (non-caching) — same logic as CheckILAttributesForUnseenStored, no decode - Add tryGetAssemblyAttribString for single-attrib string extraction, eliminating [attr] singleton-list wrapping in IncrementalBuild.fs Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/AttributeChecking.fs | 14 ++--- src/Compiler/Checking/AttributeChecking.fsi | 2 +- .../Checking/Expressions/CheckExpressions.fs | 44 ++++++-------- src/Compiler/Driver/fsc.fs | 6 +- src/Compiler/Service/IncrementalBuild.fs | 58 +++++++++++-------- src/Compiler/Service/TransparentCompiler.fs | 35 ++++++----- src/Compiler/TypedTree/TypedTreeOps.fs | 11 ---- src/Compiler/TypedTree/TypedTreeOps.fsi | 8 +-- 8 files changed, 86 insertions(+), 92 deletions(-) diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index 98c9eb95de8..22b8d442d7e 100755 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -446,13 +446,9 @@ let CheckILAttributesForUnseenStored (g: TcGlobals) (cattrsStored: ILAttributesS false /// Indicate if a list of IL attributes contains 'ObsoleteAttribute'. Used to suppress the item in intellisense. -let CheckILAttributesForUnseen (g: TcGlobals) cattrs _m = - ignore g - let hasObsolete = tryFindILAttribByFlag WellKnownILAttributes.ObsoleteAttribute cattrs |> Option.isSome - if hasObsolete then - not (tryFindILAttribByFlag WellKnownILAttributes.IsByRefLikeAttribute cattrs |> Option.isSome) - else - false +let CheckILAttributesForUnseen (cattrs: ILAttributes) = + cattrs.HasWellKnownAttribute(WellKnownILAttributes.ObsoleteAttribute) + && not (cattrs.HasWellKnownAttribute(WellKnownILAttributes.IsByRefLikeAttribute)) /// Checks the attributes for CompilerMessageAttribute, which has an IsHidden argument that allows /// items to be suppressed from intellisense. @@ -575,7 +571,7 @@ let CheckMethInfoAttributes g m tyargsOpt (minfo: MethInfo) = let MethInfoIsUnseen g (m: range) (ty: TType) minfo allowObsolete = let isUnseenByObsoleteAttrib () = match BindMethInfoAttributes m minfo - (fun ilAttribs -> Some(not allowObsolete && CheckILAttributesForUnseen g ilAttribs m)) + (fun ilAttribs -> Some(not allowObsolete && CheckILAttributesForUnseen ilAttribs)) (fun fsAttribs -> Some(CheckFSharpAttributesForUnseen g fsAttribs m allowObsolete)) #if !NO_TYPEPROVIDERS (fun provAttribs -> Some(not allowObsolete && CheckProvidedAttributesForUnseen provAttribs m)) @@ -620,7 +616,7 @@ let PropInfoIsUnseen m allowObsolete pinfo = | ILProp (ILPropInfo(_, pdef) as ilpinfo) -> // Properties on .NET tuple types are resolvable but unseen isAnyTupleTy pinfo.TcGlobals ilpinfo.ILTypeInfo.ToType || - CheckILAttributesForUnseen pinfo.TcGlobals pdef.CustomAttrs m + CheckILAttributesForUnseen pdef.CustomAttrs | FSProp (g, _, Some vref, _) | FSProp (g, _, _, Some vref) -> CheckFSharpAttributesForUnseen g vref.Attribs m allowObsolete | FSProp _ -> failwith "CheckPropInfoAttributes: unreachable" diff --git a/src/Compiler/Checking/AttributeChecking.fsi b/src/Compiler/Checking/AttributeChecking.fsi index b3b3b897727..87ef7351ce1 100644 --- a/src/Compiler/Checking/AttributeChecking.fsi +++ b/src/Compiler/Checking/AttributeChecking.fsi @@ -71,7 +71,7 @@ val MethInfoHasWellKnownAttribute: val CheckFSharpAttributes: g: TcGlobals -> attribs: Attrib list -> m: range -> OperationResult -val CheckILAttributesForUnseen: g: TcGlobals -> cattrs: ILAttributes -> _m: 'a -> bool +val CheckILAttributesForUnseen: cattrs: ILAttributes -> bool val CheckILAttributesForUnseenStored: g: TcGlobals -> cattrsStored: ILAttributesStored -> _m: 'a -> bool diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index c50f7b40e9a..df0bc80df56 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -697,6 +697,15 @@ let UnifyFunctionType extraInfo (cenv: cenv) denv mFunExpr ty = | Some argm -> error (NotAFunction(denv, ty, mFunExpr, argm)) | None -> error (FunctionExpected(denv, ty, mFunExpr)) +/// Extract the localized warning message from a WarnOnWithoutNullArgumentAttribute, if present. +let tryGetWarnOnWithoutNullMessage (g: TcGlobals) (attribs: Attrib list) = + match attribs with + | ValAttrib g WellKnownValAttributes.WarnOnWithoutNullArgumentAttribute (Attrib(_, _, [ AttribStringArg b ], namedArgs, _, _, _)) -> + match namedArgs with + | ExtractAttribNamedArg "Localize" (AttribBoolArg true) -> FSComp.SR.GetTextOpt(b) + | _ -> Some b + | _ -> Option.None + let ReportImplicitlyIgnoredBoolExpression denv m ty expr = let checkExpr m expr = match stripDebugPoints expr with @@ -5231,17 +5240,9 @@ and TcPatLongIdentActivePatternCase warnOnUpper (cenv: cenv) (env: TcEnv) vFlags let cenv = if g.checkNullness then - match vref.Attribs with - | ValAttrib g WellKnownValAttributes.WarnOnWithoutNullArgumentAttribute (Attrib(_, _, [ AttribStringArg b ], namedArgs, _, _, _)) -> - let warnMsg = - match namedArgs with - | ExtractAttribNamedArg "Localize" (AttribBoolArg true) -> FSComp.SR.GetTextOpt(b) - | _ -> Some b - - match warnMsg with - | Some _ -> { cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = warnMsg } - | None -> cenv - | _ -> cenv + match tryGetWarnOnWithoutNullMessage g vref.Attribs with + | Some _ as warnMsg -> { cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = warnMsg } + | None -> cenv else cenv @@ -9436,22 +9437,11 @@ and TcValueItemThen cenv overallTy env vref tpenv mItem afterResolution delayed | _ -> vExpr, tpenv let getCenvForVref cenv (vref:ValRef) = - match vref.Attribs with - | ValAttrib g WellKnownValAttributes.WarnOnWithoutNullArgumentAttribute (Attrib(_, _, [ AttribStringArg b ], namedArgs, _, _, _)) -> - let msg = - match namedArgs with - | ExtractAttribNamedArg "Localize" (AttribBoolArg true) -> FSComp.SR.GetTextOpt(b) - | _ -> Some b - - match msg with - | Some _ -> { cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = msg } - | None when cenv.css.WarnWhenUsingWithoutNullOnAWithNullTarget <> None -> - { cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = None } - | None -> cenv - | _ when cenv.css.WarnWhenUsingWithoutNullOnAWithNullTarget <> None -> - // We need to reset the warning back to default once in a nested call, to prevent false warnings e.g. in `Option.ofObj (Path.GetDirectoryName "")` - { cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = None} - | _ -> cenv + match tryGetWarnOnWithoutNullMessage g vref.Attribs with + | Some _ as msg -> { cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = msg } + | None when cenv.css.WarnWhenUsingWithoutNullOnAWithNullTarget <> None -> + { cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = None } + | None -> cenv let cenv = match vExpr with diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index a9e3dbf6b2f..3b6a3bfef18 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -866,9 +866,9 @@ let main3 | MetadataAssemblyGeneration.ReferenceOnly | MetadataAssemblyGeneration.ReferenceOut _ -> let hasIvt = - match topAttrs.assemblyAttrs with - | AssemblyAttribString tcGlobals WellKnownAssemblyAttributes.InternalsVisibleToAttribute _ -> true - | _ -> false + topAttrs.assemblyAttrs + |> List.exists (fun attr -> + hasFlag (classifyAssemblyAttrib tcGlobals attr) WellKnownAssemblyAttributes.InternalsVisibleToAttribute) let observer = if hasIvt then PublicAndInternal else PublicOnly diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 9022aeca5db..920b8ad3c38 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -637,19 +637,23 @@ type RawFSharpAssemblyDataBackedByLanguageService (tcConfig, tcGlobals, generate let _sigDataAttributes, sigDataResources = EncodeSignatureData(tcConfig, tcGlobals, exportRemapping, generatedCcu, outfile, true) GetResourceNameAndSignatureDataFuncs sigDataResources - let autoOpenAttrs = - topAttrs.assemblyAttrs - |> List.choose (fun attr -> - match [ attr ] with - | AssemblyAttribString tcGlobals WellKnownAssemblyAttributes.AutoOpenAttribute s -> Some s - | _ -> None) - - let ivtAttrs = - topAttrs.assemblyAttrs - |> List.choose (fun attr -> - match [ attr ] with - | AssemblyAttribString tcGlobals WellKnownAssemblyAttributes.InternalsVisibleToAttribute s -> Some s - | _ -> None) + let autoOpenAttrs, ivtAttrs = + let mutable autoOpen = [] + let mutable ivt = [] + + for attr in topAttrs.assemblyAttrs do + let flag = classifyAssemblyAttrib tcGlobals attr + + if hasFlag flag WellKnownAssemblyAttributes.AutoOpenAttribute then + match attr with + | Attrib(_, _, [ AttribStringArg s ], _, _, _, _) -> autoOpen <- s :: autoOpen + | _ -> () + elif hasFlag flag WellKnownAssemblyAttributes.InternalsVisibleToAttribute then + match attr with + | Attrib(_, _, [ AttribStringArg s ], _, _, _, _) -> ivt <- s :: ivt + | _ -> () + + List.rev autoOpen, List.rev ivt interface IRawFSharpAssemblyData with member _.GetAutoOpenAttributes() = autoOpenAttrs @@ -823,16 +827,24 @@ module IncrementalBuilderHelpers = with exn -> errorRecoveryNoRange exn None - let locale = - match topAttrs.assemblyAttrs with - | AssemblyAttribString tcGlobals WellKnownAssemblyAttributes.AssemblyCultureAttribute s -> Some s - | _ -> None - - let assemVerFromAttrib = - match topAttrs.assemblyAttrs with - | AssemblyAttribString tcGlobals WellKnownAssemblyAttributes.AssemblyVersionAttribute s -> - try Some(parseILVersion s) with _ -> None - | _ -> None + let locale, assemVerFromAttrib = + let mutable locale = None + let mutable ver = None + + for attr in topAttrs.assemblyAttrs do + let flag = classifyAssemblyAttrib tcGlobals attr + + if hasFlag flag WellKnownAssemblyAttributes.AssemblyCultureAttribute then + match attr with + | Attrib(_, _, [ AttribStringArg s ], _, _, _, _) -> locale <- Some s + | _ -> () + elif hasFlag flag WellKnownAssemblyAttributes.AssemblyVersionAttribute then + match attr with + | Attrib(_, _, [ AttribStringArg s ], _, _, _, _) -> + ver <- (try Some(parseILVersion s) with _ -> None) + | _ -> () + + locale, ver let ver = match assemVerFromAttrib with | None -> tcConfig.version.GetVersionInfo(tcConfig.implicitIncludeDir) diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index d7d37722231..663fe8c3219 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -1844,19 +1844,28 @@ type internal TransparentCompiler errorRecoveryNoRange exn None - let locale = - match topAttrs.assemblyAttrs with - | AssemblyAttribString tcGlobals WellKnownAssemblyAttributes.AssemblyCultureAttribute s -> Some s - | _ -> None - - let assemVerFromAttrib = - match topAttrs.assemblyAttrs with - | AssemblyAttribString tcGlobals WellKnownAssemblyAttributes.AssemblyVersionAttribute s -> - try - Some(parseILVersion s) - with _ -> - None - | _ -> None + let locale, assemVerFromAttrib = + let mutable locale = None + let mutable ver = None + + for attr in topAttrs.assemblyAttrs do + let flag = classifyAssemblyAttrib tcGlobals attr + + if hasFlag flag WellKnownAssemblyAttributes.AssemblyCultureAttribute then + match attr with + | Attrib(_, _, [ AttribStringArg s ], _, _, _, _) -> locale <- Some s + | _ -> () + elif hasFlag flag WellKnownAssemblyAttributes.AssemblyVersionAttribute then + match attr with + | Attrib(_, _, [ AttribStringArg s ], _, _, _, _) -> + ver <- + (try + Some(parseILVersion s) + with _ -> + None) + | _ -> () + + locale, ver let ver = match assemVerFromAttrib with diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index a6fc85a0612..30ce14afae6 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3876,17 +3876,6 @@ let (|EntityAttribString|_|) (g: TcGlobals) (flag: WellKnownEntityAttributes) (a | EntityAttrib g flag (Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> ValueSome s | _ -> ValueNone -/// Find the first attribute in a list that matches a specific well-known assembly flag. -let tryFindAssemblyAttribByFlag g flag attribs = - tryFindAttribByClassifier classifyAssemblyAttrib WellKnownAssemblyAttributes.None g flag attribs - -/// Active pattern: extract a single string argument from a well-known assembly attribute. -[] -let (|AssemblyAttribString|_|) (g: TcGlobals) (flag: WellKnownAssemblyAttributes) (attribs: Attribs) = - match tryFindAssemblyAttribByFlag g flag attribs with - | Some(Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> ValueSome s - | _ -> ValueNone - /// Map a WellKnownILAttributes flag to its entity flag + provided-type AttribInfo equivalents. let mapILFlag (g: TcGlobals) (flag: WellKnownILAttributes) : struct (WellKnownEntityAttributes * BuiltinAttribInfo option) = match flag with diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 5d97f6fbb23..151b5e57c85 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2417,6 +2417,9 @@ val classifyEntityAttrib: g: TcGlobals -> attrib: Attrib -> WellKnownEntityAttri /// Classify a single val-level attrib to its well-known flag (or None). val classifyValAttrib: g: TcGlobals -> attrib: Attrib -> WellKnownValAttributes +/// Classify a single assembly-level attrib to its well-known flag (or None). +val classifyAssemblyAttrib: g: TcGlobals -> attrib: Attrib -> WellKnownAssemblyAttributes + /// Check if an Entity has a specific well-known attribute, computing and caching flags if needed. val attribsHaveEntityFlag: g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> bool @@ -2438,11 +2441,6 @@ val (|EntityAttribInt|_|): g: TcGlobals -> flag: WellKnownEntityAttributes -> at [] val (|EntityAttribString|_|): g: TcGlobals -> flag: WellKnownEntityAttributes -> attribs: Attribs -> string voption -val tryFindAssemblyAttribByFlag: g: TcGlobals -> flag: WellKnownAssemblyAttributes -> attribs: Attribs -> Attrib option - -[] -val (|AssemblyAttribString|_|): g: TcGlobals -> flag: WellKnownAssemblyAttributes -> attribs: Attribs -> string voption - val attribsHaveValFlag: g: TcGlobals -> flag: WellKnownValAttributes -> attribs: Attribs -> bool val tryFindValAttribByFlag: g: TcGlobals -> flag: WellKnownValAttributes -> attribs: Attribs -> Attrib option From 375270b74bd6ed3a01b5754fa77cbce968e1babf Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Tue, 3 Mar 2026 16:20:00 +0100 Subject: [PATCH 56/71] Final cleanup: dead code, encapsulation, AllowNullLiteral migration, IlxGen single-scan Dead code removed: - WellKnownAttribs.Append (zero callers) - ILAttributesStored.CreateGiven(idx,attrs) two-arg overload (zero callers) - ILAttributesStored.GetCustomAttrs(int32) shim (ignored arg, fix import.fs) - MetadataIndex + GetOrComputeWellKnownFlags removed from il.fsi (no external callers) Encapsulation: - CheckFlag now returns needsWriteBack bool, removing need to expose .Flags - .Flags removed from WellKnownAttribs.fsi Migration: - TyconRefAllowsNull replaces 5 TryFindTyconRefBoolAttribute AllowNullLiteral sites with cached flag path (IL: HasWellKnownAttribute, F#: EntityTryGetBoolAttribute) Efficiency: - GenParamAttribs: gate tryFindValAttribByFlag with flag check, merge MarshalAs filter into single pass, pass valFlags to GenMarshal - GenMarshal: accept valFlags, skip all scans when MarshalAs absent - ComputeMethodImplAttribs: compute flags once, gate attribsHave + filterOut Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/AbstractIL/il.fs | 5 - src/Compiler/AbstractIL/il.fsi | 4 - src/Compiler/Checking/import.fs | 2 +- src/Compiler/CodeGen/IlxGen.fs | 365 +++++++++++--------- src/Compiler/Optimize/Optimizer.fs | 2 +- src/Compiler/TypedTree/TypedTreeOps.fs | 45 ++- src/Compiler/TypedTree/TypedTreeOps.fsi | 3 + src/Compiler/TypedTree/WellKnownAttribs.fs | 16 +- src/Compiler/TypedTree/WellKnownAttribs.fsi | 4 +- 9 files changed, 236 insertions(+), 210 deletions(-) diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index 903a3caeee3..a4c953fc9ad 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -1281,9 +1281,6 @@ type ILAttributesStored private (metadataIndex: int32, initial: ILAttributesStor repr <- Given r r - /// Backward compat — old callers that still pass metadataIndex. - member x.GetCustomAttrs(_metadataIndex: int32) : ILAttributes = x.CustomAttrs - member x.HasWellKnownAttribute(flag: WellKnownILAttributes, compute: ILAttributes -> WellKnownILAttributes) : bool = x.GetOrComputeWellKnownFlags(compute) &&& flag <> WellKnownILAttributes.None @@ -1302,8 +1299,6 @@ type ILAttributesStored private (metadataIndex: int32, initial: ILAttributesStor static member CreateGiven(attrs: ILAttributes) = ILAttributesStored(-1, Given attrs) - static member CreateGiven(idx: int32, attrs: ILAttributes) = ILAttributesStored(idx, Given attrs) - let emptyILCustomAttrs = ILAttributes [||] let mkILCustomAttrsFromArray (attrs: ILAttribute[]) = diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index 1ef4c96b297..2071b8658e4 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -912,15 +912,11 @@ type WellKnownILAttributes = [] type ILAttributesStored = member CustomAttrs: ILAttributes - member GetCustomAttrs: int32 -> ILAttributes - member MetadataIndex: int32 member HasWellKnownAttribute: flag: WellKnownILAttributes * compute: (ILAttributes -> WellKnownILAttributes) -> bool - member GetOrComputeWellKnownFlags: compute: (ILAttributes -> WellKnownILAttributes) -> WellKnownILAttributes static member CreateReader: idx: int32 * f: (int32 -> ILAttribute[]) -> ILAttributesStored static member CreateGiven: attrs: ILAttributes -> ILAttributesStored - static member CreateGiven: idx: int32 * attrs: ILAttributes -> ILAttributesStored /// Method parameters and return values. [] diff --git a/src/Compiler/Checking/import.fs b/src/Compiler/Checking/import.fs index 2c42956800e..8979bab5e77 100644 --- a/src/Compiler/Checking/import.fs +++ b/src/Compiler/Checking/import.fs @@ -208,7 +208,7 @@ module Nullness = [] type AttributesFromIL = AttributesFromIL of metadataIndex:int * attrs:ILAttributesStored with - member this.Read() = match this with| AttributesFromIL(idx,attrs) -> attrs.GetCustomAttrs(idx) + member this.Read() = match this with | AttributesFromIL(_, attrs) -> attrs.CustomAttrs member this.GetNullable(g:TcGlobals) = tryFindILAttribByFlag WellKnownILAttributes.NullableAttribute (this.Read()) |> tryParseAttributeDataToNullableByteFlags g diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index b7b9e7e7312..b5b07c62e1b 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -8800,146 +8800,150 @@ and GetStoreValCtxt cgbuf eenv (vspec: Val) = //------------------------------------------------------------------------- /// Generate encoding P/Invoke and COM marshalling information -and GenMarshal cenv attribs = - let g = cenv.g - - let otherAttribs = - // For IlReflect backend, we rely on Reflection.Emit API to emit the pseudo-custom attributes - // correctly, so we do not filter them out. - // For IlWriteBackend, we filter MarshalAs attributes - match cenv.options.ilxBackend with - | IlReflectBackend -> attribs - | IlWriteBackend -> - attribs - |> filterOutWellKnownAttribs g WellKnownEntityAttributes.None WellKnownValAttributes.MarshalAsAttribute - - match tryFindValAttribByFlag g WellKnownValAttributes.MarshalAsAttribute attribs with - | Some(Attrib(_, _, [ AttribInt32Arg unmanagedType ], namedArgs, _, _, m)) -> - let decoder = AttributeDecoder namedArgs - - let rec decodeUnmanagedType unmanagedType = - // enumeration values for System.Runtime.InteropServices.UnmanagedType taken from mscorlib.il - match unmanagedType with - | 0x0 -> ILNativeType.Empty - | 0x01 -> ILNativeType.Void - | 0x02 -> ILNativeType.Bool - | 0x03 -> ILNativeType.Int8 - | 0x04 -> ILNativeType.Byte - | 0x05 -> ILNativeType.Int16 - | 0x06 -> ILNativeType.UInt16 - | 0x07 -> ILNativeType.Int32 - | 0x08 -> ILNativeType.UInt32 - | 0x09 -> ILNativeType.Int64 - | 0x0A -> ILNativeType.UInt64 - | 0x0B -> ILNativeType.Single - | 0x0C -> ILNativeType.Double - | 0x0F -> ILNativeType.Currency - | 0x13 -> ILNativeType.BSTR - | 0x14 -> ILNativeType.LPSTR - | 0x15 -> ILNativeType.LPWSTR - | 0x16 -> ILNativeType.LPTSTR - | 0x17 -> ILNativeType.FixedSysString(decoder.FindInt32 "SizeConst" 0x0) - | 0x19 -> ILNativeType.IUnknown - | 0x1A -> ILNativeType.IDispatch - | 0x1B -> ILNativeType.Struct - | 0x1C -> ILNativeType.Interface - | 0x1D -> - let safeArraySubType = - match decoder.FindInt32 "SafeArraySubType" 0x0 with - (* enumeration values for System.Runtime.InteropServices.VarType taken from mscorlib.il *) - | 0x0 -> ILNativeVariant.Empty - | 0x1 -> ILNativeVariant.Null - | 0x02 -> ILNativeVariant.Int16 - | 0x03 -> ILNativeVariant.Int32 - | 0x0C -> ILNativeVariant.Variant - | 0x04 -> ILNativeVariant.Single - | 0x05 -> ILNativeVariant.Double - | 0x06 -> ILNativeVariant.Currency - | 0x07 -> ILNativeVariant.Date - | 0x08 -> ILNativeVariant.BSTR - | 0x09 -> ILNativeVariant.IDispatch - | 0x0a -> ILNativeVariant.Error - | 0x0b -> ILNativeVariant.Bool - | 0x0d -> ILNativeVariant.IUnknown - | 0x0e -> ILNativeVariant.Decimal - | 0x10 -> ILNativeVariant.Int8 - | 0x11 -> ILNativeVariant.UInt8 - | 0x12 -> ILNativeVariant.UInt16 - | 0x13 -> ILNativeVariant.UInt32 - | 0x15 -> ILNativeVariant.UInt64 - | 0x16 -> ILNativeVariant.Int - | 0x17 -> ILNativeVariant.UInt - | 0x18 -> ILNativeVariant.Void - | 0x19 -> ILNativeVariant.HRESULT - | 0x1a -> ILNativeVariant.PTR - | 0x1c -> ILNativeVariant.CArray - | 0x1d -> ILNativeVariant.UserDefined - | 0x1e -> ILNativeVariant.LPSTR - | 0x1B -> ILNativeVariant.SafeArray - | 0x1f -> ILNativeVariant.LPWSTR - | 0x24 -> ILNativeVariant.Record - | 0x40 -> ILNativeVariant.FileTime - | 0x41 -> ILNativeVariant.Blob - | 0x42 -> ILNativeVariant.Stream - | 0x43 -> ILNativeVariant.Storage - | 0x44 -> ILNativeVariant.StreamedObject - | 0x45 -> ILNativeVariant.StoredObject - | 0x46 -> ILNativeVariant.BlobObject - | 0x47 -> ILNativeVariant.CF - | 0x48 -> ILNativeVariant.CLSID - | 0x14 -> ILNativeVariant.Int64 - | _ -> ILNativeVariant.Empty - - let safeArrayUserDefinedSubType = - // the argument is a System.Type obj, but it's written to MD as a UTF8 string - match decoder.FindTypeName "SafeArrayUserDefinedSubType" "" with - | x when String.IsNullOrEmpty(x) -> None - | res -> - if - (safeArraySubType = ILNativeVariant.IDispatch) - || (safeArraySubType = ILNativeVariant.IUnknown) - then - Some res - else - None - - ILNativeType.SafeArray(safeArraySubType, safeArrayUserDefinedSubType) - | 0x1E -> ILNativeType.FixedArray(decoder.FindInt32 "SizeConst" 0x0) - | 0x1F -> ILNativeType.Int - | 0x20 -> ILNativeType.UInt - | 0x22 -> ILNativeType.ByValStr - | 0x23 -> ILNativeType.ANSIBSTR - | 0x24 -> ILNativeType.TBSTR - | 0x25 -> ILNativeType.VariantBool - | 0x26 -> ILNativeType.Method - | 0x28 -> ILNativeType.AsAny - | 0x2A -> - let sizeParamIndex = - match decoder.FindInt16 "SizeParamIndex" -1s with - | -1s -> None - | res -> Some(int res, None) - - let arraySubType = - match decoder.FindInt32 "ArraySubType" -1 with - | -1 -> None - | res -> Some(decodeUnmanagedType res) - - ILNativeType.Array(arraySubType, sizeParamIndex) - | 0x2B -> ILNativeType.LPSTRUCT - | 0x2C -> error (Error(FSComp.SR.ilCustomMarshallersCannotBeUsedInFSharp (), m)) - (* ILNativeType.Custom of bytes * string * string * bytes (* GUID, nativeTypeName, custMarshallerName, cookieString *) *) - //ILNativeType.Error - | 0x2D -> ILNativeType.Error - | 0x30 -> ILNativeType.LPUTF8STR - | _ -> ILNativeType.Empty - - Some(decodeUnmanagedType unmanagedType), otherAttribs - | Some(Attrib(_, _, _, _, _, _, m)) -> - errorR (Error(FSComp.SR.ilMarshalAsAttributeCannotBeDecoded (), m)) - None, attribs - | _ -> - // No MarshalAs detected +and GenMarshal cenv valFlags attribs = + if not (hasFlag valFlags WellKnownValAttributes.MarshalAsAttribute) then None, attribs + else + + let g = cenv.g + + let otherAttribs = + // For IlReflect backend, we rely on Reflection.Emit API to emit the pseudo-custom attributes + // correctly, so we do not filter them out. + // For IlWriteBackend, MarshalAs is already filtered by the caller (GenParamAttribs/ComputeMethodImplAttribs). + match cenv.options.ilxBackend with + | IlReflectBackend -> attribs + | IlWriteBackend -> + attribs + |> filterOutWellKnownAttribs g WellKnownEntityAttributes.None WellKnownValAttributes.MarshalAsAttribute + + match tryFindValAttribByFlag g WellKnownValAttributes.MarshalAsAttribute attribs with + | Some(Attrib(_, _, [ AttribInt32Arg unmanagedType ], namedArgs, _, _, m)) -> + let decoder = AttributeDecoder namedArgs + + let rec decodeUnmanagedType unmanagedType = + // enumeration values for System.Runtime.InteropServices.UnmanagedType taken from mscorlib.il + match unmanagedType with + | 0x0 -> ILNativeType.Empty + | 0x01 -> ILNativeType.Void + | 0x02 -> ILNativeType.Bool + | 0x03 -> ILNativeType.Int8 + | 0x04 -> ILNativeType.Byte + | 0x05 -> ILNativeType.Int16 + | 0x06 -> ILNativeType.UInt16 + | 0x07 -> ILNativeType.Int32 + | 0x08 -> ILNativeType.UInt32 + | 0x09 -> ILNativeType.Int64 + | 0x0A -> ILNativeType.UInt64 + | 0x0B -> ILNativeType.Single + | 0x0C -> ILNativeType.Double + | 0x0F -> ILNativeType.Currency + | 0x13 -> ILNativeType.BSTR + | 0x14 -> ILNativeType.LPSTR + | 0x15 -> ILNativeType.LPWSTR + | 0x16 -> ILNativeType.LPTSTR + | 0x17 -> ILNativeType.FixedSysString(decoder.FindInt32 "SizeConst" 0x0) + | 0x19 -> ILNativeType.IUnknown + | 0x1A -> ILNativeType.IDispatch + | 0x1B -> ILNativeType.Struct + | 0x1C -> ILNativeType.Interface + | 0x1D -> + let safeArraySubType = + match decoder.FindInt32 "SafeArraySubType" 0x0 with + (* enumeration values for System.Runtime.InteropServices.VarType taken from mscorlib.il *) + | 0x0 -> ILNativeVariant.Empty + | 0x1 -> ILNativeVariant.Null + | 0x02 -> ILNativeVariant.Int16 + | 0x03 -> ILNativeVariant.Int32 + | 0x0C -> ILNativeVariant.Variant + | 0x04 -> ILNativeVariant.Single + | 0x05 -> ILNativeVariant.Double + | 0x06 -> ILNativeVariant.Currency + | 0x07 -> ILNativeVariant.Date + | 0x08 -> ILNativeVariant.BSTR + | 0x09 -> ILNativeVariant.IDispatch + | 0x0a -> ILNativeVariant.Error + | 0x0b -> ILNativeVariant.Bool + | 0x0d -> ILNativeVariant.IUnknown + | 0x0e -> ILNativeVariant.Decimal + | 0x10 -> ILNativeVariant.Int8 + | 0x11 -> ILNativeVariant.UInt8 + | 0x12 -> ILNativeVariant.UInt16 + | 0x13 -> ILNativeVariant.UInt32 + | 0x15 -> ILNativeVariant.UInt64 + | 0x16 -> ILNativeVariant.Int + | 0x17 -> ILNativeVariant.UInt + | 0x18 -> ILNativeVariant.Void + | 0x19 -> ILNativeVariant.HRESULT + | 0x1a -> ILNativeVariant.PTR + | 0x1c -> ILNativeVariant.CArray + | 0x1d -> ILNativeVariant.UserDefined + | 0x1e -> ILNativeVariant.LPSTR + | 0x1B -> ILNativeVariant.SafeArray + | 0x1f -> ILNativeVariant.LPWSTR + | 0x24 -> ILNativeVariant.Record + | 0x40 -> ILNativeVariant.FileTime + | 0x41 -> ILNativeVariant.Blob + | 0x42 -> ILNativeVariant.Stream + | 0x43 -> ILNativeVariant.Storage + | 0x44 -> ILNativeVariant.StreamedObject + | 0x45 -> ILNativeVariant.StoredObject + | 0x46 -> ILNativeVariant.BlobObject + | 0x47 -> ILNativeVariant.CF + | 0x48 -> ILNativeVariant.CLSID + | 0x14 -> ILNativeVariant.Int64 + | _ -> ILNativeVariant.Empty + + let safeArrayUserDefinedSubType = + // the argument is a System.Type obj, but it's written to MD as a UTF8 string + match decoder.FindTypeName "SafeArrayUserDefinedSubType" "" with + | x when String.IsNullOrEmpty(x) -> None + | res -> + if + (safeArraySubType = ILNativeVariant.IDispatch) + || (safeArraySubType = ILNativeVariant.IUnknown) + then + Some res + else + None + + ILNativeType.SafeArray(safeArraySubType, safeArrayUserDefinedSubType) + | 0x1E -> ILNativeType.FixedArray(decoder.FindInt32 "SizeConst" 0x0) + | 0x1F -> ILNativeType.Int + | 0x20 -> ILNativeType.UInt + | 0x22 -> ILNativeType.ByValStr + | 0x23 -> ILNativeType.ANSIBSTR + | 0x24 -> ILNativeType.TBSTR + | 0x25 -> ILNativeType.VariantBool + | 0x26 -> ILNativeType.Method + | 0x28 -> ILNativeType.AsAny + | 0x2A -> + let sizeParamIndex = + match decoder.FindInt16 "SizeParamIndex" -1s with + | -1s -> None + | res -> Some(int res, None) + + let arraySubType = + match decoder.FindInt32 "ArraySubType" -1 with + | -1 -> None + | res -> Some(decodeUnmanagedType res) + + ILNativeType.Array(arraySubType, sizeParamIndex) + | 0x2B -> ILNativeType.LPSTRUCT + | 0x2C -> error (Error(FSComp.SR.ilCustomMarshallersCannotBeUsedInFSharp (), m)) + (* ILNativeType.Custom of bytes * string * string * bytes (* GUID, nativeTypeName, custMarshallerName, cookieString *) *) + //ILNativeType.Error + | 0x2D -> ILNativeType.Error + | 0x30 -> ILNativeType.LPUTF8STR + | _ -> ILNativeType.Empty + + Some(decodeUnmanagedType unmanagedType), otherAttribs + | Some(Attrib(_, _, _, _, _, _, m)) -> + errorR (Error(FSComp.SR.ilMarshalAsAttributeCannotBeDecoded (), m)) + None, attribs + | _ -> + // No MarshalAs detected + None, attribs /// Generate special attributes on an IL parameter and GenParamAttribs cenv paramTy attribs = @@ -8955,21 +8959,36 @@ and GenParamAttribs cenv paramTy attribs = let optionalFlag = hasFlag valFlags WellKnownValAttributes.OptionalAttribute let defaultValue = - tryFindValAttribByFlag g WellKnownValAttributes.DefaultParameterValueAttribute attribs - |> Option.bind OptionalArgInfo.FieldInitForDefaultParameterValueAttrib - // Return the filtered attributes. Do not generate In, Out, Optional or DefaultParameterValue attributes - // as custom attributes in the code - they are implicit from the IL bits for these - let attribs = - attribs - |> filterOutWellKnownAttribs - g - WellKnownEntityAttributes.None - (WellKnownValAttributes.InAttribute + if hasFlag valFlags WellKnownValAttributes.DefaultParameterValueAttribute then + tryFindValAttribByFlag g WellKnownValAttributes.DefaultParameterValueAttribute attribs + |> Option.bind OptionalArgInfo.FieldInitForDefaultParameterValueAttrib + else + None + + let filterMask = + valFlags + &&& (WellKnownValAttributes.InAttribute ||| WellKnownValAttributes.OutAttribute ||| WellKnownValAttributes.OptionalAttribute - ||| WellKnownValAttributes.DefaultParameterValueAttribute) + ||| WellKnownValAttributes.DefaultParameterValueAttribute + ||| WellKnownValAttributes.MarshalAsAttribute) - let Marshal, attribs = GenMarshal cenv attribs + // Filter out IL-implicit attributes in a single pass (only if any are present) + let attribs = + if filterMask = WellKnownValAttributes.None then + attribs + else + attribs + |> filterOutWellKnownAttribs + g + WellKnownEntityAttributes.None + (WellKnownValAttributes.InAttribute + ||| WellKnownValAttributes.OutAttribute + ||| WellKnownValAttributes.OptionalAttribute + ||| WellKnownValAttributes.DefaultParameterValueAttribute + ||| WellKnownValAttributes.MarshalAsAttribute) + + let Marshal, attribs = GenMarshal cenv valFlags attribs inFlag, outFlag, optionalFlag, defaultValue, Marshal, attribs /// Generate IL parameters @@ -9049,7 +9068,9 @@ and GenParams /// Generate IL method return information and GenReturnInfo cenv eenv returnTy ilRetTy (retInfo: ArgReprInfo) : ILReturn = - let marshal, attribs = GenMarshal cenv (retInfo.Attribs.AsList()) + let retAttribs = retInfo.Attribs.AsList() + let retValFlags = computeValWellKnownFlags cenv.g retAttribs + let marshal, attribs = GenMarshal cenv retValFlags retAttribs let ilAttribs = GenAttrs cenv eenv attribs let ilAttribs = @@ -9146,27 +9167,34 @@ and ComputeFlagFixupsForMemberBinding cenv (v: Val) = and ComputeMethodImplAttribs cenv (_v: Val) attrs = let g = cenv.g + let valFlags = computeValWellKnownFlags g attrs let implflags = - match attrs with - | ValAttribInt g WellKnownValAttributes.MethodImplAttribute flags -> flags - | _ -> 0x0 + if hasFlag valFlags WellKnownValAttributes.MethodImplAttribute then + match attrs with + | ValAttribInt g WellKnownValAttributes.MethodImplAttribute flags -> flags + | _ -> 0x0 + else + 0x0 let hasPreserveSigAttr = - attribsHaveValFlag g WellKnownValAttributes.PreserveSigAttribute attrs + hasFlag valFlags WellKnownValAttributes.PreserveSigAttribute - // strip the MethodImpl pseudo-custom attribute - // The following method implementation flags are used here - // 0x80 - hasPreserveSigImplFlag - // 0x20 - synchronize - // (See ECMA 335, Partition II, section 23.1.11 - Flags for methods [MethodImplAttributes]) let attrs = - attrs - |> filterOutWellKnownAttribs - g - WellKnownEntityAttributes.None - (WellKnownValAttributes.MethodImplAttribute - ||| WellKnownValAttributes.PreserveSigAttribute) + if + hasFlag + valFlags + (WellKnownValAttributes.MethodImplAttribute + ||| WellKnownValAttributes.PreserveSigAttribute) + then + attrs + |> filterOutWellKnownAttribs + g + WellKnownEntityAttributes.None + (WellKnownValAttributes.MethodImplAttribute + ||| WellKnownValAttributes.PreserveSigAttribute) + else + attrs let hasPreserveSigImplFlag = ((implflags &&& 0x80) <> 0x0) || hasPreserveSigAttr let hasSynchronizedImplFlag = (implflags &&& 0x20) <> 0x0 @@ -11165,7 +11193,8 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option (WellKnownValAttributes.FieldOffsetAttribute ||| WellKnownValAttributes.NonSerializedAttribute) - let ilFieldMarshal, fattribs = GenMarshal cenv fattribs + let fieldValFlags = computeValWellKnownFlags g fattribs + let ilFieldMarshal, fattribs = GenMarshal cenv fieldValFlags fattribs // The IL field is hidden if the property/field is hidden OR we're using a property // AND the field is not mutable (because we can take the address of a mutable field). diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index c982961e005..3cbb574598c 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -1662,7 +1662,7 @@ and OpHasEffect g m op = | TOp.AnonRecdGet _ -> true // conservative | TOp.ValFieldGet rfref -> rfref.RecdField.IsMutable - || (TryFindTyconRefBoolAttribute g range0 g.attrib_AllowNullLiteralAttribute rfref.TyconRef = Some true) + || (TyconRefAllowsNull g rfref.TyconRef = Some true) | TOp.ValFieldGetAddr (rfref, _readonly) -> rfref.RecdField.IsMutable | TOp.UnionCaseFieldGetAddr _ -> false // union case fields are immutable | TOp.LValueOp (LAddrOf _, _) -> false // addresses of values are always constants diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 30ce14afae6..121e6ab79e1 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3895,9 +3895,8 @@ let attribsHaveEntityFlag g (flag: WellKnownEntityAttributes) (attribs: Attribs) /// Map a WellKnownILAttributes flag to its WellKnownValAttributes equivalent. /// Check if an Entity has a specific well-known attribute, computing and caching flags if needed. let EntityHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownEntityAttributes) (entity: Entity) : bool = - let ea = entity.EntityAttribs - let struct (result, wa) = ea.CheckFlag(flag, computeEntityWellKnownFlags g) - if wa.Flags <> ea.Flags then entity.SetEntityAttribs(wa) + let struct (result, wa, changed) = entity.EntityAttribs.CheckFlag(flag, computeEntityWellKnownFlags g) + if changed then entity.SetEntityAttribs(wa) result /// Classify a single Val-level attribute, returning its well-known flag (or None). @@ -4029,16 +4028,14 @@ let filterOutWellKnownAttribs /// Check if an ArgReprInfo has a specific well-known attribute, computing and caching flags if needed. let ArgReprInfoHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownValAttributes) (argInfo: ArgReprInfo) : bool = - let wa = argInfo.Attribs - let struct (result, waNew) = wa.CheckFlag(flag, computeValWellKnownFlags g) - if waNew.Flags <> wa.Flags then argInfo.Attribs <- waNew + let struct (result, waNew, changed) = argInfo.Attribs.CheckFlag(flag, computeValWellKnownFlags g) + if changed then argInfo.Attribs <- waNew result /// Check if a Val has a specific well-known attribute, computing and caching flags if needed. let ValHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownValAttributes) (v: Val) : bool = - let va = v.ValAttribs - let struct (result, waNew) = va.CheckFlag(flag, computeValWellKnownFlags g) - if waNew.Flags <> va.Flags then v.SetValAttribs(waNew) + let struct (result, waNew, changed) = v.ValAttribs.CheckFlag(flag, computeValWellKnownFlags g) + if changed then v.SetValAttribs(waNew) result /// Query a three-state bool attribute on an entity. Returns bool option. @@ -4046,9 +4043,9 @@ let EntityTryGetBoolAttribute (g: TcGlobals) (trueFlag: WellKnownEntityAttribute if not (EntityHasWellKnownAttribute g (trueFlag ||| falseFlag) entity) then Option.None else - let ea = entity.EntityAttribs - if hasFlag ea.Flags trueFlag then Some true - else Some false + // After EntityHasWellKnownAttribute, flags are guaranteed computed + let struct (hasTrue, _, _) = entity.EntityAttribs.CheckFlag(trueFlag, computeEntityWellKnownFlags g) + if hasTrue then Some true else Some false /// Analyze three cases for attributes declared on type definitions: IL-declared attributes, F#-declared attributes and /// provided attributes. @@ -4142,6 +4139,20 @@ let HasDefaultAugmentationAttribute g (tcref: TyconRef) = | Some b -> b | None -> true +/// Check if a TyconRef has AllowNullLiteralAttribute, returning Some true/Some false/None. +let TyconRefAllowsNull (g: TcGlobals) (tcref: TyconRef) : bool option = + match metadataOfTycon tcref.Deref with +#if !NO_TYPEPROVIDERS + | ProvidedTypeMetadata _ -> TryFindTyconRefBoolAttribute g tcref.Range g.attrib_AllowNullLiteralAttribute tcref +#endif + | ILTypeMetadata(TILObjectReprData(_, _, tdef)) -> + if tdef.HasWellKnownAttribute(g, WellKnownILAttributes.AllowNullLiteralAttribute) then + Some true + else + None + | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> + EntityTryGetBoolAttribute g WellKnownEntityAttributes.AllowNullLiteralAttribute_True WellKnownEntityAttributes.AllowNullLiteralAttribute_False tcref.Deref + /// Check if a type definition has an attribute with a specific full name let TyconRefHasAttributeByName (m: range) attrFullName (tcref: TyconRef) = ignore m @@ -9668,13 +9679,13 @@ let TypeNullNever g ty = IsNonNullableStructTyparTy g ty /// The pre-nullness logic about whether a type admits the use of 'null' as a value. -let TypeNullIsExtraValue g m ty = +let TypeNullIsExtraValue g (_m: range) ty = if isILReferenceTy g ty || isDelegateTy g ty then match tryTcrefOfAppTy g ty with | ValueSome tcref -> // Putting AllowNullLiteralAttribute(false) on an IL or provided // type means 'null' can't be used with that type, otherwise it can - TryFindTyconRefBoolAttribute g m g.attrib_AllowNullLiteralAttribute tcref <> Some false + TyconRefAllowsNull g tcref <> Some false | _ -> // In pre-nullness, other IL reference types (e.g. arrays) always support null true @@ -9683,7 +9694,7 @@ let TypeNullIsExtraValue g m ty = else // In F# 4.x, putting AllowNullLiteralAttribute(true) on an F# type means 'null' can be used with that type match tryTcrefOfAppTy g ty with - | ValueSome tcref -> TryFindTyconRefBoolAttribute g m g.attrib_AllowNullLiteralAttribute tcref = Some true + | ValueSome tcref -> TyconRefAllowsNull g tcref = Some true | ValueNone -> // Consider type parameters @@ -9691,7 +9702,7 @@ let TypeNullIsExtraValue g m ty = // Any mention of a type with AllowNullLiteral(true) is considered to be with-null let intrinsicNullnessOfTyconRef g (tcref: TyconRef) = - match TryFindTyconRefBoolAttribute g tcref.Range g.attrib_AllowNullLiteralAttribute tcref with + match TyconRefAllowsNull g tcref with | Some true -> g.knownWithNull | _ -> g.knownWithoutNull @@ -9783,7 +9794,7 @@ let GetDisallowedNullness (g:TcGlobals) (ty:TType) = let TypeHasAllowNull (tcref:TyconRef) g m = not tcref.IsStructOrEnumTycon && not (isByrefLikeTyconRef g m tcref) && - (TryFindTyconRefBoolAttribute g m g.attrib_AllowNullLiteralAttribute tcref = Some true) + (TyconRefAllowsNull g tcref = Some true) /// The new logic about whether a type admits the use of 'null' as a value. let TypeNullIsExtraValueNew g m ty = diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 151b5e57c85..732c80533fb 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2498,6 +2498,9 @@ val TyconRefHasAttributeByName: range -> string -> TyconRef -> bool /// Check if a TyconRef has a well-known attribute, handling both IL and F# metadata with O(1) flag tests. val TyconRefHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownILAttributes -> tcref: TyconRef -> bool +/// Check if a TyconRef has AllowNullLiteralAttribute, returning Some true/Some false/None. +val TyconRefAllowsNull: g: TcGlobals -> tcref: TyconRef -> bool option + /// Try to find the AttributeUsage attribute, looking for the value of the AllowMultiple named parameter val TryFindAttributeUsageAttribute: TcGlobals -> range -> TyconRef -> bool option diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fs b/src/Compiler/TypedTree/WellKnownAttribs.fs index ce0a1f0737a..0736deffaee 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fs +++ b/src/Compiler/TypedTree/WellKnownAttribs.fs @@ -143,13 +143,6 @@ type internal WellKnownAttribs<'TItem, 'TFlags when 'TFlags: enum> = WellKnownAttribs<'TItem, 'TFlags>(attrib :: x.attribs, combined) - /// Append items and OR-in flags. - member x.Append(others: 'TItem list, flags: 'TFlags) = - let combined = - LanguagePrimitives.EnumOfValue(LanguagePrimitives.EnumToValue x.flags ||| LanguagePrimitives.EnumToValue flags) - - WellKnownAttribs<'TItem, 'TFlags>(x.attribs @ others, combined) - /// Returns a copy with recomputed flags (flags set to NotComputed, i.e. bit 63). member x.WithRecomputedFlags() = if x.attribs.IsEmpty then @@ -157,8 +150,8 @@ type internal WellKnownAttribs<'TItem, 'TFlags when 'TFlags: enum> = else WellKnownAttribs<'TItem, 'TFlags>(x.attribs, LanguagePrimitives.EnumOfValue(1uL <<< 63)) - /// Caller must write back the returned wrapper if flags were recomputed. - member x.CheckFlag(flag: 'TFlags, compute: 'TItem list -> 'TFlags) : struct (bool * WellKnownAttribs<'TItem, 'TFlags>) = + /// Caller must write back the returned wrapper if needsWriteBack is true. + member x.CheckFlag(flag: 'TFlags, compute: 'TItem list -> 'TFlags) : struct (bool * WellKnownAttribs<'TItem, 'TFlags> * bool) = let f = LanguagePrimitives.EnumToValue x.flags if f &&& (1uL <<< 63) <> 0uL then @@ -167,6 +160,7 @@ type internal WellKnownAttribs<'TItem, 'TFlags when 'TFlags: enum> = struct (LanguagePrimitives.EnumToValue computed &&& LanguagePrimitives.EnumToValue flag <> 0uL, - wa) + wa, + true) else - struct (x.HasWellKnownAttribute(flag), x) + struct (x.HasWellKnownAttribute(flag), x, false) diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fsi b/src/Compiler/TypedTree/WellKnownAttribs.fsi index 121da64c2e1..fbebf705cf0 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fsi +++ b/src/Compiler/TypedTree/WellKnownAttribs.fsi @@ -121,8 +121,6 @@ type internal WellKnownAttribs<'TItem, 'TFlags when 'TFlags: enum> = val private flags: 'TFlags new: attribs: 'TItem list * flags: 'TFlags -> WellKnownAttribs<'TItem, 'TFlags> member AsList: unit -> 'TItem list - member Flags: 'TFlags member Add: attrib: 'TItem * flag: 'TFlags -> WellKnownAttribs<'TItem, 'TFlags> - member Append: others: 'TItem list * flags: 'TFlags -> WellKnownAttribs<'TItem, 'TFlags> member WithRecomputedFlags: unit -> WellKnownAttribs<'TItem, 'TFlags> - member CheckFlag: flag: 'TFlags * compute: ('TItem list -> 'TFlags) -> struct (bool * WellKnownAttribs<'TItem, 'TFlags>) + member CheckFlag: flag: 'TFlags * compute: ('TItem list -> 'TFlags) -> struct (bool * WellKnownAttribs<'TItem, 'TFlags> * bool) From 90d63d5c964b3696a8967cbe7da60cdc6390c27c Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 5 Mar 2026 13:12:15 +0100 Subject: [PATCH 57/71] Add ValueAsStaticPropertyAttribute to WellKnownValAttributes for O(1) lookup Replace List.exists with string comparison on hot path in Val.IsCompiledAsStaticPropertyWithoutField and PostInferenceChecks with cached WellKnownValAttributes flag check. - Add ValueAsStaticPropertyAttribute flag at bit 39 in WellKnownValAttributes - Add classifyValAttrib entry for the attribute - Simplify Val.IsCompiledAsStaticPropertyWithoutField to use HasWellKnownAttribute - Replace inline string scan in PostInferenceChecks with ValHasWellKnownAttribute - Expose HasWellKnownAttribute and Flags in WellKnownAttribs.fsi Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/PostInferenceChecks.fs | 2 +- src/Compiler/TypedTree/TypedTree.fs | 7 ++++--- src/Compiler/TypedTree/TypedTreeOps.fs | 1 + src/Compiler/TypedTree/WellKnownAttribs.fs | 1 + src/Compiler/TypedTree/WellKnownAttribs.fsi | 6 +++++- 5 files changed, 12 insertions(+), 5 deletions(-) diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index ee658880e39..09e95d5bbf1 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -2207,7 +2207,7 @@ let CheckModuleBinding cenv env (TBind(v, e, _) as bind) = IsSimpleSyntacticConstantExpr g e && // Check the thing is actually compiled as a property IsCompiledAsStaticProperty g v || - (g.compilingFSharpCore && v.Attribs |> List.exists(fun (Attrib(tc, _, _, _, _, _, _)) -> tc.CompiledName = "ValueAsStaticPropertyAttribute")) + (g.compilingFSharpCore && ValHasWellKnownAttribute g WellKnownValAttributes.ValueAsStaticPropertyAttribute v) then v.SetIsCompiledAsStaticPropertyWithoutField() diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 5db1ad62450..40a1d2aa24e 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -2986,9 +2986,10 @@ type Val = member x.HasBeenReferenced = x.val_flags.HasBeenReferenced /// Indicates if the backing field for a static value is suppressed. - member x.IsCompiledAsStaticPropertyWithoutField = - let hasValueAsStaticProperty = x.Attribs |> List.exists(fun (Attrib(tc, _, _, _, _, _, _)) -> tc.CompiledName = "ValueAsStaticPropertyAttribute") - x.val_flags.IsCompiledAsStaticPropertyWithoutField || hasValueAsStaticProperty + member x.IsCompiledAsStaticPropertyWithoutField = + x.val_flags.IsCompiledAsStaticPropertyWithoutField + || (x.ValAttribs: WellKnownValAttribs) + .HasWellKnownAttribute(WellKnownValAttributes.ValueAsStaticPropertyAttribute) /// Indicates if the value is pinned/fixed member x.IsFixed = x.val_flags.IsFixed diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 121e6ab79e1..c0e65ec501b 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3970,6 +3970,7 @@ let classifyValAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownValAttributes = | "CLIEventAttribute" -> WellKnownValAttributes.CLIEventAttribute | "CompiledNameAttribute" -> WellKnownValAttributes.CompiledNameAttribute | "WarnOnWithoutNullArgumentAttribute" -> WellKnownValAttributes.WarnOnWithoutNullArgumentAttribute + | "ValueAsStaticPropertyAttribute" -> WellKnownValAttributes.ValueAsStaticPropertyAttribute | _ -> WellKnownValAttributes.None | [| "Microsoft"; "FSharp"; "Core"; "CompilerServices"; name |] -> match name with diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fs b/src/Compiler/TypedTree/WellKnownAttribs.fs index 0736deffaee..9d2418a6a9f 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fs +++ b/src/Compiler/TypedTree/WellKnownAttribs.fs @@ -113,6 +113,7 @@ type internal WellKnownValAttributes = | WarnOnWithoutNullArgumentAttribute = (1uL <<< 36) | MarshalAsAttribute = (1uL <<< 37) | NoEagerConstraintApplicationAttribute = (1uL <<< 38) + | ValueAsStaticPropertyAttribute = (1uL <<< 39) | NotComputed = (1uL <<< 63) /// Generic wrapper for an item list together with cached well-known attribute flags. diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fsi b/src/Compiler/TypedTree/WellKnownAttribs.fsi index fbebf705cf0..0185f3f1e38 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fsi +++ b/src/Compiler/TypedTree/WellKnownAttribs.fsi @@ -111,6 +111,7 @@ type internal WellKnownValAttributes = | WarnOnWithoutNullArgumentAttribute = (1uL <<< 36) | MarshalAsAttribute = (1uL <<< 37) | NoEagerConstraintApplicationAttribute = (1uL <<< 38) + | ValueAsStaticPropertyAttribute = (1uL <<< 39) | NotComputed = (1uL <<< 63) /// Generic wrapper for an item list together with cached well-known attribute flags. @@ -121,6 +122,9 @@ type internal WellKnownAttribs<'TItem, 'TFlags when 'TFlags: enum> = val private flags: 'TFlags new: attribs: 'TItem list * flags: 'TFlags -> WellKnownAttribs<'TItem, 'TFlags> member AsList: unit -> 'TItem list + member HasWellKnownAttribute: flag: 'TFlags -> bool member Add: attrib: 'TItem * flag: 'TFlags -> WellKnownAttribs<'TItem, 'TFlags> member WithRecomputedFlags: unit -> WellKnownAttribs<'TItem, 'TFlags> - member CheckFlag: flag: 'TFlags * compute: ('TItem list -> 'TFlags) -> struct (bool * WellKnownAttribs<'TItem, 'TFlags> * bool) + + member CheckFlag: + flag: 'TFlags * compute: ('TItem list -> 'TFlags) -> struct (bool * WellKnownAttribs<'TItem, 'TFlags> * bool) From c779b76b7a32c7035b7d2bb1f28baecc71728e76 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 5 Mar 2026 14:42:42 +0100 Subject: [PATCH 58/71] Add HasWellKnownAttribute members on Entity and Val for transparent caching Add convenience members that encapsulate the CheckFlag + write-back pattern directly on Entity and Val types. This eliminates the need for callers to manually remember the write-back step when checking well-known attribute flags. - Entity.HasWellKnownAttribute(flag, computeFlags) encapsulates cache update - Val.HasWellKnownAttribute(flag, computeFlags) encapsulates cache update - EntityHasWellKnownAttribute now forwards to entity.HasWellKnownAttribute - ValHasWellKnownAttribute now forwards to v.HasWellKnownAttribute - EntityTryGetBoolAttribute uses entity.HasWellKnownAttribute for first check - Both members declared in .fsi signature files Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TypedTree.fs | 12 ++++++++++++ src/Compiler/TypedTree/TypedTree.fsi | 6 ++++++ src/Compiler/TypedTree/TypedTreeOps.fs | 11 +++-------- 3 files changed, 21 insertions(+), 8 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 40a1d2aa24e..2c56bbdb1bd 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -1356,6 +1356,12 @@ type Entity = member x.SetEntityAttribs (attribs: WellKnownEntityAttribs) = x.entity_attribs <- attribs + /// Check if this entity has a specific well-known attribute, computing and caching flags if needed. + member x.HasWellKnownAttribute(flag: WellKnownEntityAttributes, computeFlags: Attribs -> WellKnownEntityAttributes) : bool = + let struct (result, wa, changed) = x.EntityAttribs.CheckFlag(flag, computeFlags) + if changed then x.SetEntityAttribs(wa) + result + /// Sets the structness of a record or union type definition member x.SetIsStructRecordOrUnion b = let flags = x.entity_flags in x.entity_flags <- EntityFlags(flags.IsPrefixDisplay, flags.IsModuleOrNamespace, flags.PreEstablishedHasDefaultConstructor, flags.HasSelfReferentialConstructor, b) @@ -3328,6 +3334,12 @@ type Val = | Some optData -> optData.val_attribs <- attribs | _ -> x.val_opt_data <- Some { Val.NewEmptyValOptData() with val_attribs = attribs } + /// Check if this val has a specific well-known attribute, computing and caching flags if needed. + member x.HasWellKnownAttribute(flag: WellKnownValAttributes, computeFlags: Attribs -> WellKnownValAttributes) : bool = + let struct (result, waNew, changed) = x.ValAttribs.CheckFlag(flag, computeFlags) + if changed then x.SetValAttribs(waNew) + result + member x.SetMemberInfo member_info = match x.val_opt_data with | Some optData -> optData.val_member_info <- Some member_info diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index b4d56a72f75..cf9ad99f29b 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -474,6 +474,9 @@ type Entity = /// Set the custom attributes wrapper on an F# type definition. member SetEntityAttribs: WellKnownEntityAttribs -> unit + /// Check if this entity has a specific well-known attribute, computing and caching flags if needed. + member HasWellKnownAttribute: flag: WellKnownEntityAttributes * computeFlags: (Attribs -> WellKnownEntityAttributes) -> bool + member SetCompiledName: name: string option -> unit member SetExceptionInfo: exn_info: ExceptionInfo -> unit @@ -1989,6 +1992,9 @@ type Val = member SetValAttribs: attribs: WellKnownValAttribs -> unit + /// Check if this val has a specific well-known attribute, computing and caching flags if needed. + member HasWellKnownAttribute: flag: WellKnownValAttributes * computeFlags: (Attribs -> WellKnownValAttributes) -> bool + /// Set all the data on a value member SetData: tg: ValData -> unit diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index c0e65ec501b..ed52c953409 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3895,9 +3895,7 @@ let attribsHaveEntityFlag g (flag: WellKnownEntityAttributes) (attribs: Attribs) /// Map a WellKnownILAttributes flag to its WellKnownValAttributes equivalent. /// Check if an Entity has a specific well-known attribute, computing and caching flags if needed. let EntityHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownEntityAttributes) (entity: Entity) : bool = - let struct (result, wa, changed) = entity.EntityAttribs.CheckFlag(flag, computeEntityWellKnownFlags g) - if changed then entity.SetEntityAttribs(wa) - result + entity.HasWellKnownAttribute(flag, computeEntityWellKnownFlags g) /// Classify a single Val-level attribute, returning its well-known flag (or None). let classifyValAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownValAttributes = @@ -4035,16 +4033,13 @@ let ArgReprInfoHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownValAttribute /// Check if a Val has a specific well-known attribute, computing and caching flags if needed. let ValHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownValAttributes) (v: Val) : bool = - let struct (result, waNew, changed) = v.ValAttribs.CheckFlag(flag, computeValWellKnownFlags g) - if changed then v.SetValAttribs(waNew) - result + v.HasWellKnownAttribute(flag, computeValWellKnownFlags g) /// Query a three-state bool attribute on an entity. Returns bool option. let EntityTryGetBoolAttribute (g: TcGlobals) (trueFlag: WellKnownEntityAttributes) (falseFlag: WellKnownEntityAttributes) (entity: Entity) : bool option = - if not (EntityHasWellKnownAttribute g (trueFlag ||| falseFlag) entity) then + if not (entity.HasWellKnownAttribute(trueFlag ||| falseFlag, computeEntityWellKnownFlags g)) then Option.None else - // After EntityHasWellKnownAttribute, flags are guaranteed computed let struct (hasTrue, _, _) = entity.EntityAttribs.CheckFlag(trueFlag, computeEntityWellKnownFlags g) if hasTrue then Some true else Some false From d37c588c5f6c8498b31ad88419cf3559b0d4d915 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 5 Mar 2026 15:16:26 +0100 Subject: [PATCH 59/71] Add WellKnownMethAttribute struct to bundle correlated attribute check parameters Introduce WellKnownMethAttribute struct that bundles ILFlag, ValFlag, and AttribInfo for well-known attribute checks on MethInfo. Add MethInfoHasWellKnownAttributeSpec overload that takes the bundled struct, delegating to the original function. Update all 3 callsites to use the new struct-based API, eliminating the risk of passing mismatched flags. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/AttributeChecking.fs | 12 ++++++++++++ src/Compiler/Checking/AttributeChecking.fsi | 9 +++++++++ .../Checking/Expressions/CheckExpressions.fs | 9 ++++++++- src/Compiler/Checking/MethodCalls.fs | 9 ++++++++- src/Compiler/Checking/NameResolution.fs | 8 +++++++- 5 files changed, 44 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index 22b8d442d7e..0a24d8502c4 100755 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -231,6 +231,14 @@ let MethInfoHasAttribute g m attribSpec minfo = (fun _ -> Some ()) |> Option.isSome +/// Bundles the IL flag, Val flag, and AttribInfo for a well-known attribute +/// that can appear on method infos across metadata kinds. +[] +type WellKnownMethAttribute = + { ILFlag: WellKnownILAttributes + ValFlag: WellKnownValAttributes + AttribInfo: BuiltinAttribInfo } + /// Fast O(1) attribute check for ILMeth (cached IL flags) and FSMeth (cached Val flags). /// Falls back to MethInfoHasAttribute for provided methods. let rec MethInfoHasWellKnownAttribute g (m: range) (ilFlag: WellKnownILAttributes) (valFlag: WellKnownValAttributes) (attribSpec: BuiltinAttribInfo) (minfo: MethInfo) = @@ -243,6 +251,10 @@ let rec MethInfoHasWellKnownAttribute g (m: range) (ilFlag: WellKnownILAttribute | ProvidedMeth _ -> MethInfoHasAttribute g m attribSpec minfo #endif +/// Check if a MethInfo has a well-known attribute, using a bundled spec. +let MethInfoHasWellKnownAttributeSpec (g: TcGlobals) (m: range) (spec: WellKnownMethAttribute) (minfo: MethInfo) = + MethInfoHasWellKnownAttribute g m spec.ILFlag spec.ValFlag spec.AttribInfo minfo + let private CheckCompilerFeatureRequiredAttribute cattrs msg m = // In some cases C# will generate both ObsoleteAttribute and CompilerFeatureRequiredAttribute. // Specifically, when default constructor is generated for class with any required members in them. diff --git a/src/Compiler/Checking/AttributeChecking.fsi b/src/Compiler/Checking/AttributeChecking.fsi index 87ef7351ce1..7585f97b9bd 100644 --- a/src/Compiler/Checking/AttributeChecking.fsi +++ b/src/Compiler/Checking/AttributeChecking.fsi @@ -60,6 +60,12 @@ val TryFindMethInfoStringAttribute: val MethInfoHasAttribute: g: TcGlobals -> m: range -> attribSpec: BuiltinAttribInfo -> minfo: MethInfo -> bool +[] +type WellKnownMethAttribute = + { ILFlag: WellKnownILAttributes + ValFlag: WellKnownValAttributes + AttribInfo: BuiltinAttribInfo } + val MethInfoHasWellKnownAttribute: g: TcGlobals -> m: range -> @@ -69,6 +75,9 @@ val MethInfoHasWellKnownAttribute: minfo: MethInfo -> bool +val MethInfoHasWellKnownAttributeSpec: + g: TcGlobals -> m: range -> spec: WellKnownMethAttribute -> minfo: MethInfo -> bool + val CheckFSharpAttributes: g: TcGlobals -> attribs: Attrib list -> m: range -> OperationResult val CheckILAttributesForUnseen: cattrs: ILAttributes -> bool diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index df0bc80df56..94fb63211aa 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -10218,7 +10218,14 @@ and TcMethodApplication_CheckArguments | Some (unnamedInfo, namedInfo) -> let calledObjArgTys = meth.CalledObjArgTys mMethExpr if (calledObjArgTys, callerObjArgTys) ||> Seq.forall2 (fun calledTy callerTy -> - let noEagerConstraintApplication = MethInfoHasWellKnownAttribute g mMethExpr WellKnownILAttributes.NoEagerConstraintApplicationAttribute WellKnownValAttributes.NoEagerConstraintApplicationAttribute g.attrib_NoEagerConstraintApplicationAttribute meth.Method + let noEagerConstraintApplication = + MethInfoHasWellKnownAttributeSpec + g + mMethExpr + { ILFlag = WellKnownILAttributes.NoEagerConstraintApplicationAttribute + ValFlag = WellKnownValAttributes.NoEagerConstraintApplicationAttribute + AttribInfo = g.attrib_NoEagerConstraintApplicationAttribute } + meth.Method // The logic associated with NoEagerConstraintApplicationAttribute is part of the // Tasks and Resumable Code RFC diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 2ea041144ad..19c100f4158 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -918,7 +918,14 @@ let ExamineArgumentForLambdaPropagation (infoReader: InfoReader) ad noEagerConst CalledArgMatchesType(adjustedCalledArgTy, noEagerConstraintApplication) let ExamineMethodForLambdaPropagation (g: TcGlobals) m (meth: CalledMeth) ad = - let noEagerConstraintApplication = MethInfoHasWellKnownAttribute g m WellKnownILAttributes.NoEagerConstraintApplicationAttribute WellKnownValAttributes.NoEagerConstraintApplicationAttribute g.attrib_NoEagerConstraintApplicationAttribute meth.Method + let noEagerConstraintApplication = + MethInfoHasWellKnownAttributeSpec + g + m + { ILFlag = WellKnownILAttributes.NoEagerConstraintApplicationAttribute + ValFlag = WellKnownValAttributes.NoEagerConstraintApplicationAttribute + AttribInfo = g.attrib_NoEagerConstraintApplicationAttribute } + meth.Method // The logic associated with NoEagerConstraintApplicationAttribute is part of the // Tasks and Resumable Code RFC diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 5348468127d..1974395d283 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -543,7 +543,13 @@ let IsMethInfoPlainCSharpStyleExtensionMember g m isEnclExtTy (minfo: MethInfo) not minfo.IsInstance && not minfo.IsExtensionMember && (match minfo.NumArgs with [x] when x >= 1 -> true | _ -> false) && - MethInfoHasWellKnownAttribute g m WellKnownILAttributes.ExtensionAttribute WellKnownValAttributes.ExtensionAttribute g.attrib_ExtensionAttribute minfo + MethInfoHasWellKnownAttributeSpec + g + m + { ILFlag = WellKnownILAttributes.ExtensionAttribute + ValFlag = WellKnownValAttributes.ExtensionAttribute + AttribInfo = g.attrib_ExtensionAttribute } + minfo let GetTyconRefForExtensionMembers minfo (deref: Entity) amap m g = try From 297f8fb8ad7d34dbd22583d4f8cd45c74dde7aa7 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 5 Mar 2026 15:46:15 +0100 Subject: [PATCH 60/71] Add ValTryGetBoolAttribute for three-state bool attribute queries on Val Mirrors EntityTryGetBoolAttribute to provide symmetric API for querying True/False/NotPresent attribute states on Val nodes. Supports flag pairs: ReflectedDefinition, DefaultValue, NoDynamicInvocation. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TypedTreeOps.fs | 8 ++++++++ src/Compiler/TypedTree/TypedTreeOps.fsi | 8 ++++++++ 2 files changed, 16 insertions(+) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index ed52c953409..0f702e0dbda 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -4043,6 +4043,14 @@ let EntityTryGetBoolAttribute (g: TcGlobals) (trueFlag: WellKnownEntityAttribute let struct (hasTrue, _, _) = entity.EntityAttribs.CheckFlag(trueFlag, computeEntityWellKnownFlags g) if hasTrue then Some true else Some false +/// Query a three-state bool attribute on a Val. Returns bool option. +let ValTryGetBoolAttribute (g: TcGlobals) (trueFlag: WellKnownValAttributes) (falseFlag: WellKnownValAttributes) (v: Val) : bool option = + if not (v.HasWellKnownAttribute(trueFlag ||| falseFlag, computeValWellKnownFlags g)) then + Option.None + else + let struct (hasTrue, _, _) = v.ValAttribs.CheckFlag(trueFlag, computeValWellKnownFlags g) + if hasTrue then Some true else Some false + /// Analyze three cases for attributes declared on type definitions: IL-declared attributes, F#-declared attributes and /// provided attributes. // diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 732c80533fb..5935aaec408 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2475,6 +2475,14 @@ val EntityTryGetBoolAttribute: entity: Entity -> bool option +/// Query a three-state bool attribute on a Val. Returns bool option. +val ValTryGetBoolAttribute: + g: TcGlobals -> + trueFlag: WellKnownValAttributes -> + falseFlag: WellKnownValAttributes -> + v: Val -> + bool option + val IsMatchingFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attrib -> bool val HasFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> bool From 9d3789b04c3296a2b991848ad641677753d2542a Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 5 Mar 2026 16:06:49 +0100 Subject: [PATCH 61/71] Remove unused parameters from AttributeChecking functions - Remove unused _g from CheckILExperimentalAttributes (private) - Remove unused _m from CheckILAttributesForUnseenStored and update .fsi - Remove unused _m from CheckFSharpAttributesForUnseen and update .fsi - Prefix newly-unused m params with _ in PropInfoIsUnseen and IsValUnseen - Add cross-reference doc comments between CheckILAttributesForUnseen variants - Update all callsites in NameResolution.fs and AttributeChecking.fs Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/AttributeChecking.fs | 16 +++++++++------- src/Compiler/Checking/AttributeChecking.fsi | 6 +++--- src/Compiler/Checking/NameResolution.fs | 10 +++++----- 3 files changed, 17 insertions(+), 15 deletions(-) diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index 0a24d8502c4..ba62a69e4be 100755 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -275,7 +275,7 @@ let private extractILAttributeInfo namedArgs = let urlFormat = extractILAttribValueFrom "UrlFormat" namedArgs (diagnosticId, urlFormat) -let private CheckILExperimentalAttributes (_g: TcGlobals) cattrs m = +let private CheckILExperimentalAttributes cattrs m = match cattrs with // [Experimental("DiagnosticId")] // [Experimental(diagnosticId: "DiagnosticId")] @@ -342,7 +342,7 @@ let private CheckILObsoleteAttributes (g: TcGlobals) isByrefLikeTyconRef cattrs let private CheckILAttributes (g: TcGlobals) isByrefLikeTyconRef cattrs m = trackErrors { do! CheckILObsoleteAttributes g isByrefLikeTyconRef cattrs m - do! CheckILExperimentalAttributes g cattrs m + do! CheckILExperimentalAttributes cattrs m } let private extractObsoleteAttributeInfo namedArgs = @@ -451,13 +451,15 @@ let private CheckProvidedAttributes (g: TcGlobals) m (provAttribs: Tainted Some(not allowObsolete && CheckILAttributesForUnseen ilAttribs)) - (fun fsAttribs -> Some(CheckFSharpAttributesForUnseen g fsAttribs m allowObsolete)) + (fun fsAttribs -> Some(CheckFSharpAttributesForUnseen g fsAttribs allowObsolete)) #if !NO_TYPEPROVIDERS (fun provAttribs -> Some(not allowObsolete && CheckProvidedAttributesForUnseen provAttribs m)) #else @@ -623,14 +625,14 @@ let MethInfoIsUnseen g (m: range) (ty: TType) minfo allowObsolete = /// Indicate if a property has 'Obsolete' or 'CompilerMessageAttribute'. /// Used to suppress the item in intellisense. -let PropInfoIsUnseen m allowObsolete pinfo = +let PropInfoIsUnseen _m allowObsolete pinfo = match pinfo with | ILProp (ILPropInfo(_, pdef) as ilpinfo) -> // Properties on .NET tuple types are resolvable but unseen isAnyTupleTy pinfo.TcGlobals ilpinfo.ILTypeInfo.ToType || CheckILAttributesForUnseen pdef.CustomAttrs | FSProp (g, _, Some vref, _) - | FSProp (g, _, _, Some vref) -> CheckFSharpAttributesForUnseen g vref.Attribs m allowObsolete + | FSProp (g, _, _, Some vref) -> CheckFSharpAttributesForUnseen g vref.Attribs allowObsolete | FSProp _ -> failwith "CheckPropInfoAttributes: unreachable" #if !NO_TYPEPROVIDERS | ProvidedProp (_amap, pi, m) -> diff --git a/src/Compiler/Checking/AttributeChecking.fsi b/src/Compiler/Checking/AttributeChecking.fsi index 7585f97b9bd..c8198e4a985 100644 --- a/src/Compiler/Checking/AttributeChecking.fsi +++ b/src/Compiler/Checking/AttributeChecking.fsi @@ -82,13 +82,13 @@ val CheckFSharpAttributes: g: TcGlobals -> attribs: Attrib list -> m: range -> O val CheckILAttributesForUnseen: cattrs: ILAttributes -> bool -val CheckILAttributesForUnseenStored: g: TcGlobals -> cattrsStored: ILAttributesStored -> _m: 'a -> bool +val CheckILAttributesForUnseenStored: g: TcGlobals -> cattrsStored: ILAttributesStored -> bool val CheckFSharpAttributesForHidden: g: TcGlobals -> attribs: Attrib list -> bool val CheckFSharpAttributesForObsolete: g: TcGlobals -> attribs: Attrib list -> bool -val CheckFSharpAttributesForUnseen: g: TcGlobals -> attribs: Attrib list -> _m: 'a -> allowObsolete: bool -> bool +val CheckFSharpAttributesForUnseen: g: TcGlobals -> attribs: Attrib list -> allowObsolete: bool -> bool val CheckPropInfoAttributes: pinfo: PropInfo -> m: range -> OperationResult @@ -99,7 +99,7 @@ val CheckMethInfoAttributes: val MethInfoIsUnseen: g: TcGlobals -> m: range -> ty: TType -> minfo: MethInfo -> allowObsolete: bool -> bool -val PropInfoIsUnseen: m: 'a -> allowObsolete: bool -> pinfo: PropInfo -> bool +val PropInfoIsUnseen: _m: 'a -> allowObsolete: bool -> pinfo: PropInfo -> bool val CheckEntityAttributes: g: TcGlobals -> tcref: TyconRef -> m: range -> OperationResult diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 1974395d283..4cc9cf2ef85 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -4321,21 +4321,21 @@ let IsTyconUnseenObsoleteSpec ad g amap m (x: TyconRef) allowObsolete = not (IsEntityAccessible amap m ad x) || ((not allowObsolete) && (if x.IsILTycon then - CheckILAttributesForUnseenStored g x.ILTyconRawMetadata.CustomAttrsStored m + CheckILAttributesForUnseenStored g x.ILTyconRawMetadata.CustomAttrsStored else - CheckFSharpAttributesForUnseen g x.Attribs m allowObsolete)) + CheckFSharpAttributesForUnseen g x.Attribs allowObsolete)) let IsTyconUnseen ad g amap m allowObsolete (x: TyconRef) = IsTyconUnseenObsoleteSpec ad g amap m x allowObsolete -let IsValUnseen ad g m allowObsolete (v: ValRef) = +let IsValUnseen ad g _m allowObsolete (v: ValRef) = v.IsCompilerGenerated || v.Deref.IsClassConstructor || not (IsValAccessible ad v) || - not allowObsolete && CheckFSharpAttributesForUnseen g v.Attribs m allowObsolete + not allowObsolete && CheckFSharpAttributesForUnseen g v.Attribs allowObsolete let IsUnionCaseUnseen ad g amap m allowObsolete (ucref: UnionCaseRef) = not (IsUnionCaseAccessible amap m ad ucref) || - not allowObsolete && (IsTyconUnseen ad g amap m allowObsolete ucref.TyconRef || CheckFSharpAttributesForUnseen g ucref.Attribs m allowObsolete) + not allowObsolete && (IsTyconUnseen ad g amap m allowObsolete ucref.TyconRef || CheckFSharpAttributesForUnseen g ucref.Attribs allowObsolete) let ItemIsUnseen ad g amap m allowObsolete item = match item with From 309123044fa76f34dce3954b89f1d5c3d4d404b8 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 5 Mar 2026 16:36:18 +0100 Subject: [PATCH 62/71] Rewrite TryFindAutoOpenAttr and TryFindInternalsVisibleToAttr to use classifyILAttrib Replace hand-rolled isILAttribByName checks with the modern classifyILAttrib flag-based API for consistency with the rest of the attribute classification infrastructure. Remove unused tname_AutoOpenAttr binding. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TypedTreeOps.fs | 31 +++++++++++++------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 0f702e0dbda..49f9befad6e 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -8818,28 +8818,29 @@ let mkSignatureDataVersionAttr (g: TcGlobals) (version: ILVersionInfo) = ILAttribElem.Int32 (int32 version.Minor) ILAttribElem.Int32 (int32 version.Build)], []) -let tname_AutoOpenAttr = Core + ".AutoOpenAttribute" - let IsSignatureDataVersionAttr cattr = isILAttribByName ([], tname_SignatureDataVersionAttr) cattr -let TryFindAutoOpenAttr cattr = - if isILAttribByName ([], tname_AutoOpenAttr) cattr then - match decodeILAttribData cattr with - | [ILAttribElem.String s], _ -> s +let TryFindAutoOpenAttr (cattr: ILAttribute) = + if classifyILAttrib cattr &&& WellKnownILAttributes.AutoOpenAttribute <> WellKnownILAttributes.None then + match decodeILAttribData cattr with + | [ ILAttribElem.String s ], _ -> s | [], _ -> None - | _ -> - warning(Failure(FSComp.SR.tastUnexpectedDecodeOfAutoOpenAttribute())) + | _ -> + warning (Failure(FSComp.SR.tastUnexpectedDecodeOfAutoOpenAttribute())) None else None - -let TryFindInternalsVisibleToAttr cattr = - if isILAttribByName ([], tname_InternalsVisibleToAttribute) cattr then - match decodeILAttribData cattr with - | [ILAttribElem.String s], _ -> s + +let TryFindInternalsVisibleToAttr (cattr: ILAttribute) = + if + classifyILAttrib cattr + &&& WellKnownILAttributes.InternalsVisibleToAttribute <> WellKnownILAttributes.None + then + match decodeILAttribData cattr with + | [ ILAttribElem.String s ], _ -> s | [], _ -> None - | _ -> - warning(Failure(FSComp.SR.tastUnexpectedDecodeOfInternalsVisibleToAttribute())) + | _ -> + warning (Failure(FSComp.SR.tastUnexpectedDecodeOfInternalsVisibleToAttribute())) None else None From 54e44e0e93d5ff8ca98d0ef682fa79ce66185725 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 5 Mar 2026 16:54:15 +0100 Subject: [PATCH 63/71] Add well-known attribute API navigation guide comment block Add a comprehensive navigation comment block before the attribute helpers section in TypedTreeOps.fs. The comment documents all well-known attribute APIs organized by category: existence checks, ad-hoc checks, data extraction active patterns, bool queries, IL-level operations, cross-metadata dispatch, and classification functions. Notes that MethInfoHasWellKnownAttribute lives in AttributeChecking.fs. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TypedTreeOps.fs | 48 ++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 49f9befad6e..bebc5669e79 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3838,6 +3838,54 @@ let classifyAssemblyAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownAssemblyAt | _ -> WellKnownAssemblyAttributes.None | ValueNone -> WellKnownAssemblyAttributes.None +// --------------------------------------------------------------- +// Well-Known Attribute APIs — Navigation Guide +// --------------------------------------------------------------- +// +// This section provides O(1) cached lookups for well-known attributes. +// Choose the right API based on what you have and what you need: +// +// EXISTENCE CHECKS (cached, O(1) after first call): +// EntityHasWellKnownAttribute g flag entity — Entity (type/module) +// ValHasWellKnownAttribute g flag v — Val (value/member) +// ArgReprInfoHasWellKnownAttribute g flag arg — ArgReprInfo (parameter) +// +// AD-HOC CHECKS (no cache, re-scans each call): +// attribsHaveEntityFlag g flag attribs — raw Attrib list, entity flags +// attribsHaveValFlag g flag attribs — raw Attrib list, val flags +// +// DATA EXTRACTION (active patterns): +// (|EntityAttrib|_|) g flag attribs — returns full Attrib +// (|ValAttrib|_|) g flag attribs — returns full Attrib +// (|EntityAttribInt|_|) g flag attribs — extracts int32 argument +// (|EntityAttribString|_|) g flag attribs — extracts string argument +// (|ValAttribInt|_|) g flag attribs — extracts int32 argument +// (|ValAttribString|_|) g flag attribs — extracts string argument +// +// BOOL ATTRIBUTE QUERIES (three-state: Some true / Some false / None): +// EntityTryGetBoolAttribute g trueFlag falseFlag entity +// ValTryGetBoolAttribute g trueFlag falseFlag v +// +// IL-LEVEL (operates on ILAttribute / ILAttributes): +// classifyILAttrib attr — classify a single IL attr +// (|ILAttribDecoded|_|) flag cattrs — find & decode by flag +// ILAttributes.HasWellKnownAttribute(flag) — existence check (no cache) +// ILAttributesStored.HasWellKnownAttribute(g, flag) — cached existence +// +// CROSS-METADATA (IL + F# + Provided type dispatch): +// TyconRefHasWellKnownAttribute g flag tcref +// TyconRefAllowsNull g tcref +// +// CROSS-METADATA (in AttributeChecking.fs): +// MethInfoHasWellKnownAttribute g m ilFlag valFlag attribSpec minfo +// MethInfoHasWellKnownAttributeSpec g m spec minfo — convenience wrapper +// +// CLASSIFICATION (maps attribute → flag enum): +// classifyEntityAttrib g attrib — Attrib → WellKnownEntityAttributes +// classifyValAttrib g attrib — Attrib → WellKnownValAttributes +// classifyILAttrib attr — ILAttribute → WellKnownILAttributes +// --------------------------------------------------------------- + /// Shared combinator: find first attrib matching a flag via a classify function. let inline internal tryFindAttribByClassifier ([] classify: TcGlobals -> Attrib -> 'Flag) (none: 'Flag) (g: TcGlobals) (flag: 'Flag) (attribs: Attribs) : Attrib option = attribs |> List.tryFind (fun attrib -> classify g attrib &&& flag <> none) From 2830d4ef979406444dc34a55f0fc07dd604f5c83 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Thu, 5 Mar 2026 19:35:09 +0100 Subject: [PATCH 64/71] Fix verifier issues: BSL baseline, CompilerCompat test bugs, trailing newlines - Commit updated surface area baseline removing stale ILAttributesStored entries - Fix reserved keyword 'sealed' used as variable name in CompilerCompat Program.fs - Fully qualify StructRecord.Y field for cross-project resolution - Add trailing newlines to Library.fs and AttributeUsage.fs Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../CustomAttributes/AttributeUsage/AttributeUsage.fs | 2 +- .../FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl | 5 ----- tests/projects/CompilerCompat/CompilerCompatApp/Program.fs | 6 +++--- tests/projects/CompilerCompat/CompilerCompatLib/Library.fs | 2 +- 4 files changed, 5 insertions(+), 10 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs index 77e3974f9f4..491981ab196 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs @@ -1039,4 +1039,4 @@ let _ = x.IsA """ |> typecheck |> shouldFail - |> withErrorCode 39 \ No newline at end of file + |> withErrorCode 39 diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl index a248b48d23e..8150abd8ed4 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl @@ -303,14 +303,9 @@ FSharp.Compiler.AbstractIL.IL+ILAttributes: ILAttribute[] AsArray() FSharp.Compiler.AbstractIL.IL+ILAttributes: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+ILAttribute] AsList() FSharp.Compiler.AbstractIL.IL+ILAttributesStored: Boolean HasWellKnownAttribute(WellKnownILAttributes, Microsoft.FSharp.Core.FSharpFunc`2[FSharp.Compiler.AbstractIL.IL+ILAttributes,FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes]) FSharp.Compiler.AbstractIL.IL+ILAttributesStored: ILAttributes CustomAttrs -FSharp.Compiler.AbstractIL.IL+ILAttributesStored: ILAttributes GetCustomAttrs(Int32) FSharp.Compiler.AbstractIL.IL+ILAttributesStored: ILAttributes get_CustomAttrs() FSharp.Compiler.AbstractIL.IL+ILAttributesStored: ILAttributesStored CreateGiven(ILAttributes) -FSharp.Compiler.AbstractIL.IL+ILAttributesStored: ILAttributesStored CreateGiven(Int32, ILAttributes) FSharp.Compiler.AbstractIL.IL+ILAttributesStored: ILAttributesStored CreateReader(Int32, Microsoft.FSharp.Core.FSharpFunc`2[System.Int32,FSharp.Compiler.AbstractIL.IL+ILAttribute[]]) -FSharp.Compiler.AbstractIL.IL+ILAttributesStored: Int32 MetadataIndex -FSharp.Compiler.AbstractIL.IL+ILAttributesStored: Int32 get_MetadataIndex() -FSharp.Compiler.AbstractIL.IL+ILAttributesStored: WellKnownILAttributes GetOrComputeWellKnownFlags(Microsoft.FSharp.Core.FSharpFunc`2[FSharp.Compiler.AbstractIL.IL+ILAttributes,FSharp.Compiler.AbstractIL.IL+WellKnownILAttributes]) FSharp.Compiler.AbstractIL.IL+ILCallingConv: Boolean Equals(ILCallingConv) FSharp.Compiler.AbstractIL.IL+ILCallingConv: Boolean Equals(ILCallingConv, System.Collections.IEqualityComparer) FSharp.Compiler.AbstractIL.IL+ILCallingConv: Boolean Equals(System.Object) diff --git a/tests/projects/CompilerCompat/CompilerCompatApp/Program.fs b/tests/projects/CompilerCompat/CompilerCompatApp/Program.fs index deb5ec48570..b643a77c711 100644 --- a/tests/projects/CompilerCompat/CompilerCompatApp/Program.fs +++ b/tests/projects/CompilerCompat/CompilerCompatApp/Program.fs @@ -43,10 +43,10 @@ let main _argv = printfn "Processed result: %s" processed // Test well-known attribute types - let sealed = CompilerCompatLib.Library.SealedType() - printfn "Sealed: %d" sealed.Value + let sealedObj = CompilerCompatLib.Library.SealedType() + printfn "Sealed: %d" sealedObj.Value - let sr = { CompilerCompatLib.Library.StructRecord.X = 1; Y = 2.0 } + let sr = { CompilerCompatLib.Library.StructRecord.X = 1; CompilerCompatLib.Library.StructRecord.Y = 2.0 } printfn "Struct: %d, %f" sr.X sr.Y let u = CompilerCompatLib.Library.NoHelpersUnion.Case1 diff --git a/tests/projects/CompilerCompat/CompilerCompatLib/Library.fs b/tests/projects/CompilerCompat/CompilerCompatLib/Library.fs index 3eb32f66b68..085a50e99a8 100644 --- a/tests/projects/CompilerCompat/CompilerCompatLib/Library.fs +++ b/tests/projects/CompilerCompat/CompilerCompatLib/Library.fs @@ -39,4 +39,4 @@ module Library = /// Function with ReflectedDefinition [] - let reflectedFunction x = x + 1 \ No newline at end of file + let reflectedFunction x = x + 1 From 7da15fabbde62e838bd6d7b985e64ccde851201c Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 6 Mar 2026 00:42:32 +0100 Subject: [PATCH 65/71] Add TailCallAttribute to WellKnownValAttributes for O(1) flag-based lookup - Add TailCallAttribute = (1uL <<< 40) to WellKnownValAttributes enum (.fs and .fsi) - Add TailCallAttribute classification in classifyValAttrib under Microsoft.FSharp.Core - Remove HasTailCallAttrib from TcGlobals; replace with hasTailCallAttrib helper in TailCallChecks - Helper uses O(1) flag lookup with fallback for user-defined shadow attributes Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Checking/TailCallChecks.fs | 12 +++++- src/Compiler/TypedTree/TcGlobals.fs | 3 -- src/Compiler/TypedTree/TcGlobals.fsi | 45 --------------------- src/Compiler/TypedTree/TypedTreeOps.fs | 1 + src/Compiler/TypedTree/WellKnownAttribs.fs | 1 + src/Compiler/TypedTree/WellKnownAttribs.fsi | 1 + 6 files changed, 13 insertions(+), 50 deletions(-) diff --git a/src/Compiler/Checking/TailCallChecks.fs b/src/Compiler/Checking/TailCallChecks.fs index f1bb333e28f..87ee24bbdb4 100644 --- a/src/Compiler/Checking/TailCallChecks.fs +++ b/src/Compiler/Checking/TailCallChecks.fs @@ -15,6 +15,14 @@ open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypeRelations +/// Check for TailCallAttribute via O(1) flag lookup, with fallback for user-defined shadow types. +let private hasTailCallAttrib (g: TcGlobals) (attribs: Attribs) = + attribsHaveValFlag g WellKnownValAttributes.TailCallAttribute attribs + || attribs + |> List.exists (fun (Attrib(tcref, _, _, _, _, _, _)) -> + tcref.IsLocalRef + && tcref.CompiledRepresentationForNamedType.FullName = "Microsoft.FSharp.Core.TailCallAttribute") + [] let (|ValUseAtApp|_|) e = match e with @@ -756,7 +764,7 @@ let CheckModuleBinding cenv (isRec: bool) (TBind _ as bind) = // warn for non-rec functions which have the attribute if cenv.g.langVersion.SupportsFeature LanguageFeature.WarningWhenTailCallAttrOnNonRec then - if not isRec && cenv.g.HasTailCallAttrib bind.Var.Attribs then + if not isRec && hasTailCallAttrib cenv.g bind.Var.Attribs then warning (Error(FSComp.SR.chkTailCallAttrOnNonRec (), bind.Var.Range)) // Check if a let binding to the result of a rec expression is not inside the rec expression @@ -839,7 +847,7 @@ and CheckDefnInModule cenv mdef = let mustTailCall = Seq.fold (fun mustTailCall (v: Val) -> - if cenv.g.HasTailCallAttrib v.Attribs then + if hasTailCallAttrib cenv.g v.Attribs then let newSet = Zset.add v mustTailCall newSet else diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index ecb27e1bf97..ef6e00ffb16 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -1849,9 +1849,6 @@ type TcGlobals( member _.DebuggerNonUserCodeAttribute = debuggerNonUserCodeAttribute - member _.HasTailCallAttrib (attribs: Attribs) = - attribs - |> List.exists (fun a -> a.TyconRef.CompiledRepresentationForNamedType.FullName = "Microsoft.FSharp.Core.TailCallAttribute") member _.MakeInternalsVisibleToAttribute(simpleAssemName) = mkILCustomAttribute (tref_InternalsVisibleToAttribute, [ilg.typ_String], [ILAttribElem.String (Some simpleAssemName)], []) diff --git a/src/Compiler/TypedTree/TcGlobals.fsi b/src/Compiler/TypedTree/TcGlobals.fsi index 74014373e82..e27bc1605a2 100644 --- a/src/Compiler/TypedTree/TcGlobals.fsi +++ b/src/Compiler/TypedTree/TcGlobals.fsi @@ -190,8 +190,6 @@ type internal TcGlobals = member FindSysTyconRef: path: string list -> nm: string -> TypedTree.EntityRef - member HasTailCallAttrib: attribs: TypedTree.Attribs -> bool - /// Find an FSharp.Core LanguagePrimitives dynamic function that corresponds to a trait witness, e.g. /// AdditionDynamic for op_Addition. Also work out the type instantiation of the dynamic function. member MakeBuiltInWitnessInfo: t: TypedTree.TraitConstraintInfo -> IntrinsicValRef * TypedTree.TType list @@ -306,98 +304,58 @@ type internal TcGlobals = member array_tcr_nice: TypedTree.EntityRef - member attrib_AllowNullLiteralAttribute: BuiltinAttribInfo member attrib_AttributeUsageAttribute: BuiltinAttribInfo member attrib_AutoOpenAttribute: BuiltinAttribInfo - - - - - - - - member attrib_ComparisonConditionalOnAttribute: BuiltinAttribInfo member attrib_CompilationArgumentCountsAttribute: BuiltinAttribInfo member attrib_CompilationMappingAttribute: BuiltinAttribInfo - member attrib_CompiledNameAttribute: BuiltinAttribInfo member attrib_ConditionalAttribute: BuiltinAttribInfo - - - member attrib_CustomOperationAttribute: BuiltinAttribInfo - - - member attrib_DefaultMemberAttribute: BuiltinAttribInfo - member attrib_DefaultValueAttribute: BuiltinAttribInfo member attrib_DllImportAttribute: BuiltinAttribInfo option member attrib_DynamicDependencyAttribute: BuiltinAttribInfo - member attrib_EqualityConditionalOnAttribute: BuiltinAttribInfo member attrib_ExtensionAttribute: BuiltinAttribInfo - member attrib_FlagsAttribute: BuiltinAttribInfo - - - member attrib_InAttribute: BuiltinAttribInfo - - member attrib_IsReadOnlyAttribute: BuiltinAttribInfo member attrib_IsUnmanagedAttribute: BuiltinAttribInfo - - member attrib_MeasureAttribute: BuiltinAttribInfo - member attrib_MemberNotNullWhenAttribute: BuiltinAttribInfo - - - - member attrib_NoEagerConstraintApplicationAttribute: BuiltinAttribInfo - - member attrib_NullableAttribute: BuiltinAttribInfo member attrib_NullableContextAttribute: BuiltinAttribInfo - - - member attrib_ParamArrayAttribute: BuiltinAttribInfo - - - member attrib_ReflectedDefinitionAttribute: BuiltinAttribInfo - member attrib_SealedAttribute: BuiltinAttribInfo member attrib_SecurityAttribute: BuiltinAttribInfo option @@ -412,13 +370,10 @@ type internal TcGlobals = member attrib_IsByRefLikeAttribute_opt: BuiltinAttribInfo option - member attrib_TypeForwardedToAttribute: BuiltinAttribInfo - member attribs_Unsupported: TypedTree.TyconRef list - member bitwise_and_info: IntrinsicValRef member bitwise_and_vref: TypedTree.ValRef diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index bebc5669e79..3a0c2bd1811 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -4017,6 +4017,7 @@ let classifyValAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownValAttributes = | "CompiledNameAttribute" -> WellKnownValAttributes.CompiledNameAttribute | "WarnOnWithoutNullArgumentAttribute" -> WellKnownValAttributes.WarnOnWithoutNullArgumentAttribute | "ValueAsStaticPropertyAttribute" -> WellKnownValAttributes.ValueAsStaticPropertyAttribute + | "TailCallAttribute" -> WellKnownValAttributes.TailCallAttribute | _ -> WellKnownValAttributes.None | [| "Microsoft"; "FSharp"; "Core"; "CompilerServices"; name |] -> match name with diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fs b/src/Compiler/TypedTree/WellKnownAttribs.fs index 9d2418a6a9f..db5812d5e12 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fs +++ b/src/Compiler/TypedTree/WellKnownAttribs.fs @@ -114,6 +114,7 @@ type internal WellKnownValAttributes = | MarshalAsAttribute = (1uL <<< 37) | NoEagerConstraintApplicationAttribute = (1uL <<< 38) | ValueAsStaticPropertyAttribute = (1uL <<< 39) + | TailCallAttribute = (1uL <<< 40) | NotComputed = (1uL <<< 63) /// Generic wrapper for an item list together with cached well-known attribute flags. diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fsi b/src/Compiler/TypedTree/WellKnownAttribs.fsi index 0185f3f1e38..3ff91b4bc65 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fsi +++ b/src/Compiler/TypedTree/WellKnownAttribs.fsi @@ -112,6 +112,7 @@ type internal WellKnownValAttributes = | MarshalAsAttribute = (1uL <<< 37) | NoEagerConstraintApplicationAttribute = (1uL <<< 38) | ValueAsStaticPropertyAttribute = (1uL <<< 39) + | TailCallAttribute = (1uL <<< 40) | NotComputed = (1uL <<< 63) /// Generic wrapper for an item list together with cached well-known attribute flags. From 3bb534fafccf8a33b1e5ad451cfd9ac4092716d3 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 6 Mar 2026 01:26:35 +0100 Subject: [PATCH 66/71] Consolidate TypeProviderAssemblyAttribute detection into classifyAssemblyAttrib Add WellKnownAssemblyAttributes.TypeProviderAssemblyAttribute flag and classify it under Microsoft.FSharp.Core.CompilerServices in classifyAssemblyAttrib. Fold detection into the existing assembly attribute classification loop in IncrementalBuild.fs and TransparentCompiler.fs, eliminating a duplicate List.exists scan over topAttrs.assemblyAttrs. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/Service/IncrementalBuild.fs | 9 ++++----- src/Compiler/Service/TransparentCompiler.fs | 11 ++++------- src/Compiler/TypedTree/TypedTreeOps.fs | 4 ++++ src/Compiler/TypedTree/WellKnownAttribs.fs | 1 + src/Compiler/TypedTree/WellKnownAttribs.fsi | 1 + 5 files changed, 14 insertions(+), 12 deletions(-) diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 920b8ad3c38..ab53f7dd4cb 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -815,6 +815,8 @@ module IncrementalBuilderHelpers = let generatedCcu = tcState.Ccu.CloneWithFinalizedContents(ccuContents) + let mutable hasTypeProviderAssemblyAttrib = false + // Compute the identity of the generated assembly based on attributes, options etc. // Some of this is duplicated from fsc.fs let ilAssemRef = @@ -843,6 +845,8 @@ module IncrementalBuilderHelpers = | Attrib(_, _, [ AttribStringArg s ], _, _, _, _) -> ver <- (try Some(parseILVersion s) with _ -> None) | _ -> () + elif hasFlag flag WellKnownAssemblyAttributes.TypeProviderAssemblyAttribute then + hasTypeProviderAssemblyAttrib <- true locale, ver let ver = @@ -855,11 +859,6 @@ module IncrementalBuilderHelpers = try // Assemblies containing type provider components cannot successfully be used via cross-assembly references. // We return 'None' for the assembly portion of the cross-assembly reference - let hasTypeProviderAssemblyAttrib = - topAttrs.assemblyAttrs |> List.exists (fun (Attrib(tcref, _, _, _, _, _, _)) -> - let nm = tcref.CompiledRepresentationForNamedType.BasicQualifiedName - nm = !! typeof.FullName) - if tcState.CreatesGeneratedProvidedTypes || hasTypeProviderAssemblyAttrib then ProjectAssemblyDataResult.Unavailable true else diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index 663fe8c3219..1016a6ea8f2 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -1830,6 +1830,8 @@ type internal TransparentCompiler let generatedCcu = tcState.Ccu.CloneWithFinalizedContents(ccuContents) + let mutable hasTypeProviderAssemblyAttrib = false + // Compute the identity of the generated assembly based on attributes, options etc. // Some of this is duplicated from fsc.fs let ilAssemRef = @@ -1864,6 +1866,8 @@ type internal TransparentCompiler with _ -> None) | _ -> () + elif hasFlag flag WellKnownAssemblyAttributes.TypeProviderAssemblyAttribute then + hasTypeProviderAssemblyAttrib <- true locale, ver @@ -1878,13 +1882,6 @@ type internal TransparentCompiler try // Assemblies containing type provider components cannot successfully be used via cross-assembly references. // We return 'None' for the assembly portion of the cross-assembly reference - let hasTypeProviderAssemblyAttrib = - topAttrs.assemblyAttrs - |> List.exists (fun (Attrib(tcref, _, _, _, _, _, _)) -> - let nm = tcref.CompiledRepresentationForNamedType.BasicQualifiedName - - nm = !!typeof.FullName) - if tcState.CreatesGeneratedProvidedTypes || hasTypeProviderAssemblyAttrib then ProjectAssemblyDataResult.Unavailable true else diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 3a0c2bd1811..8f06196e6b4 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3835,6 +3835,10 @@ let classifyAssemblyAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownAssemblyAt match name with | "AutoOpenAttribute" -> WellKnownAssemblyAttributes.AutoOpenAttribute | _ -> WellKnownAssemblyAttributes.None + | [| "Microsoft"; "FSharp"; "Core"; "CompilerServices"; name |] -> + match name with + | "TypeProviderAssemblyAttribute" -> WellKnownAssemblyAttributes.TypeProviderAssemblyAttribute + | _ -> WellKnownAssemblyAttributes.None | _ -> WellKnownAssemblyAttributes.None | ValueNone -> WellKnownAssemblyAttributes.None diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fs b/src/Compiler/TypedTree/WellKnownAttribs.fs index db5812d5e12..c05f0207551 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fs +++ b/src/Compiler/TypedTree/WellKnownAttribs.fs @@ -67,6 +67,7 @@ type internal WellKnownAssemblyAttributes = | InternalsVisibleToAttribute = (1uL <<< 1) | AssemblyCultureAttribute = (1uL <<< 2) | AssemblyVersionAttribute = (1uL <<< 3) + | TypeProviderAssemblyAttribute = (1uL <<< 4) | NotComputed = (1uL <<< 63) /// Flags enum for well-known attributes on Val (values and members). diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fsi b/src/Compiler/TypedTree/WellKnownAttribs.fsi index 3ff91b4bc65..7f7a47c722f 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fsi +++ b/src/Compiler/TypedTree/WellKnownAttribs.fsi @@ -66,6 +66,7 @@ type internal WellKnownAssemblyAttributes = | InternalsVisibleToAttribute = (1uL <<< 1) | AssemblyCultureAttribute = (1uL <<< 2) | AssemblyVersionAttribute = (1uL <<< 3) + | TypeProviderAssemblyAttribute = (1uL <<< 4) | NotComputed = (1uL <<< 63) /// Flags enum for well-known attributes on Val (values and members). From 99caa9d74a68f3ff91c06829c4b036cba4240058 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 6 Mar 2026 02:13:14 +0100 Subject: [PATCH 67/71] Fast-path DefaultMemberAttribute in indexer resolution Extract shared tryBindTyconRefAttributeCore with WellKnownILAttributes voption parameter. Both TryBindTyconRefAttribute and TryBindTyconRefAttributeWithILFlag delegate to it, eliminating code duplication while preserving the O(1) flag check fast-path on the IL metadata path. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../Checking/Expressions/CheckExpressions.fs | 2 +- src/Compiler/TypedTree/TypedTreeOps.fs | 84 +++++++++++++++---- src/Compiler/TypedTree/TypedTreeOps.fsi | 5 ++ 3 files changed, 74 insertions(+), 17 deletions(-) diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 94fb63211aa..170ec8fb18c 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -6708,7 +6708,7 @@ and TcIndexingThen cenv env overallTy mWholeExpr mDot tpenv setInfo synLeftExprO | None -> match tryTcrefOfAppTy g ty with | ValueSome tcref -> - TryFindTyconRefStringAttribute g mWholeExpr g.attrib_DefaultMemberAttribute tcref + TryFindTyconRefStringAttributeFast g mWholeExpr WellKnownILAttributes.DefaultMemberAttribute g.attrib_DefaultMemberAttribute tcref | _ -> let item = Some "Item" match AllPropInfosOfTypeInScope ResultCollectionSettings.AtMostOneResult cenv.infoReader env.NameEnv item ad IgnoreOverrides mWholeExpr ty with diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index 8f06196e6b4..d25a5ec5e6f 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -4104,29 +4104,57 @@ let ValTryGetBoolAttribute (g: TcGlobals) (trueFlag: WellKnownValAttributes) (fa let struct (hasTrue, _, _) = v.ValAttribs.CheckFlag(trueFlag, computeValWellKnownFlags g) if hasTrue then Some true else Some false -/// Analyze three cases for attributes declared on type definitions: IL-declared attributes, F#-declared attributes and -/// provided attributes. -// -// This is used for AttributeUsageAttribute, DefaultMemberAttribute and ConditionalAttribute (on attribute types) -let TryBindTyconRefAttribute g (m: range) (AttribInfo (atref, _) as args) (tcref: TyconRef) f1 f2 (f3: obj option list * (string * obj option) list -> 'a option) : 'a option = - ignore m; ignore f3 - match metadataOfTycon tcref.Deref with +/// Shared core for binding attributes on type definitions, supporting an optional +/// WellKnownILAttributes flag for O(1) early exit on the IL metadata path. +let private tryBindTyconRefAttributeCore + g + (m: range) + (ilFlag: WellKnownILAttributes voption) + (AttribInfo(atref, _) as args) + (tcref: TyconRef) + f1 + f2 + (f3: obj option list * (string * obj option) list -> 'a option) + : 'a option + = + ignore m + ignore f3 + + match metadataOfTycon tcref.Deref with #if !NO_TYPEPROVIDERS - | ProvidedTypeMetadata info -> - let provAttribs = info.ProvidedType.PApply((fun a -> (a :> IProvidedCustomAttributeProvider)), m) - match provAttribs.PUntaint((fun a -> a.GetAttributeConstructorArgs(provAttribs.TypeProvider.PUntaintNoFailure id, atref.FullName)), m) with + | ProvidedTypeMetadata info -> + let provAttribs = + info.ProvidedType.PApply((fun a -> (a :> IProvidedCustomAttributeProvider)), m) + + match + provAttribs.PUntaint( + (fun a -> + a.GetAttributeConstructorArgs(provAttribs.TypeProvider.PUntaintNoFailure id, atref.FullName)), + m + ) + with | Some args -> f3 args | None -> None #endif - | ILTypeMetadata (TILObjectReprData(_, _, tdef)) -> - match TryDecodeILAttribute atref tdef.CustomAttrs with - | Some attr -> f1 attr - | _ -> None - | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> - match TryFindFSharpAttribute g args tcref.Attribs with + | ILTypeMetadata(TILObjectReprData(_, _, tdef)) -> + match ilFlag with + | ValueSome flag when not (tdef.HasWellKnownAttribute(g, flag)) -> None + | _ -> + match TryDecodeILAttribute atref tdef.CustomAttrs with + | Some attr -> f1 attr + | _ -> None + | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> + match TryFindFSharpAttribute g args tcref.Attribs with | Some attr -> f2 attr | _ -> None +/// Analyze three cases for attributes declared on type definitions: IL-declared attributes, F#-declared attributes and +/// provided attributes. +// +// This is used for AttributeUsageAttribute, DefaultMemberAttribute and ConditionalAttribute (on attribute types) +let TryBindTyconRefAttribute g (m: range) args (tcref: TyconRef) f1 f2 f3 : 'a option = + tryBindTyconRefAttributeCore g m ValueNone args tcref f1 f2 f3 + let TryFindTyconRefBoolAttribute g m attribSpec tcref = TryBindTyconRefAttribute g m attribSpec tcref (function @@ -4162,6 +4190,30 @@ let TryFindTyconRefStringAttribute g m attribSpec tcref = (function Attrib(_, _, [ AttribStringArg msg ], _, _, _, _) -> Some msg | _ -> None) (function [ Some (:? string as msg : obj) ], _ -> Some msg | _ -> None) +/// Like TryBindTyconRefAttribute but with a fast-path flag check on the IL metadata path. +/// Skips the full attribute scan if the cached flag indicates the attribute is absent. +let TryBindTyconRefAttributeWithILFlag g (m: range) (ilFlag: WellKnownILAttributes) args (tcref: TyconRef) f1 f2 f3 : 'a option = + tryBindTyconRefAttributeCore g m (ValueSome ilFlag) args tcref f1 f2 f3 + +/// Like TryFindTyconRefStringAttribute but with a fast-path flag check on the IL path. +/// Use this when the attribute has a corresponding WellKnownILAttributes flag for O(1) early exit. +let TryFindTyconRefStringAttributeFast g m ilFlag attribSpec tcref = + TryBindTyconRefAttributeWithILFlag + g + m + ilFlag + attribSpec + tcref + (function + | [ ILAttribElem.String(Some msg) ], _ -> Some msg + | _ -> None) + (function + | Attrib(_, _, [ AttribStringArg msg ], _, _, _, _) -> Some msg + | _ -> None) + (function + | [ Some(:? string as msg: obj) ], _ -> Some msg + | _ -> None) + /// Check if a type definition has a specific attribute let TyconRefHasAttribute g m attribSpec tcref = TryBindTyconRefAttribute g m attribSpec tcref diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 5935aaec408..3f842467237 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2494,6 +2494,11 @@ val TryFindFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> Attrib /// This is used to detect the 'DefaultMemberAttribute' and 'ConditionalAttribute' attributes (on type definitions) val TryFindTyconRefStringAttribute: TcGlobals -> range -> BuiltinAttribInfo -> TyconRef -> string option +/// Like TryFindTyconRefStringAttribute but with a fast-path flag check on the IL path. +/// Use this when the attribute has a corresponding WellKnownILAttributes flag for O(1) early exit. +val TryFindTyconRefStringAttributeFast: + TcGlobals -> range -> WellKnownILAttributes -> BuiltinAttribInfo -> TyconRef -> string option + /// Try to find a specific attribute on a type definition, where the attribute accepts a bool argument. val TryFindTyconRefBoolAttribute: TcGlobals -> range -> BuiltinAttribInfo -> TyconRef -> bool option From e31b5e48550ce9e1395b7d7a57deec5d273e8c63 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 6 Mar 2026 05:29:50 +0100 Subject: [PATCH 68/71] Remove duplicate DefaultAugmentation(false) test The test 'DefaultAugmentation(false) suppresses helpers' in AttributeUsage.fs was a near-duplicate of the more specific 'Is* discriminated union properties are unavailable with DefaultAugmentation(false)' test in DiscriminatedUnionTests.fs. Remove the duplicate per TEST-CODE-QUALITY verifier feedback. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../AttributeUsage/AttributeUsage.fs | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs index 491981ab196..df6dca7e61e 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs @@ -1028,15 +1028,3 @@ type Derived() = (Error 945, Line 7, Col 13, Line 7, Col 17, "Cannot inherit a sealed type") ] - [] - let ``DefaultAugmentation(false) suppresses helpers`` () = - Fsx """ -[] -type DU = A | B of int - -let x = DU.A -let _ = x.IsA - """ - |> typecheck - |> shouldFail - |> withErrorCode 39 From 9b1ef998ef293c0e88f9931e582ca73370457849 Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 6 Mar 2026 14:38:03 +0100 Subject: [PATCH 69/71] AugmentWishHashCompare - remove 7 bools in matches --- .../Checking/AugmentWithHashCompare.fs | 158 +++++++++--------- src/Compiler/TypedTree/TypedTree.fs | 11 ++ src/Compiler/TypedTree/TypedTree.fsi | 3 + src/Compiler/TypedTree/TypedTreeOps.fs | 4 + src/Compiler/TypedTree/TypedTreeOps.fsi | 3 + src/Compiler/TypedTree/WellKnownAttribs.fsi | 1 + 6 files changed, 103 insertions(+), 77 deletions(-) diff --git a/src/Compiler/Checking/AugmentWithHashCompare.fs b/src/Compiler/Checking/AugmentWithHashCompare.fs index 96d42f18fc0..0d3c12b7599 100644 --- a/src/Compiler/Checking/AugmentWithHashCompare.fs +++ b/src/Compiler/Checking/AugmentWithHashCompare.fs @@ -1029,16 +1029,55 @@ let canBeAugmentedWithEquals g (tycon: Tycon) = let canBeAugmentedWithCompare g (tycon: Tycon) = tycon.IsUnionTycon || tycon.IsRecordTycon || isTrueFSharpStructTycon g tycon +/// Bitmask of the 7 equality/comparison augmentation attributes. +let augmentationAttrMask = + WellKnownEntityAttributes.NoEqualityAttribute + ||| WellKnownEntityAttributes.CustomEqualityAttribute + ||| WellKnownEntityAttributes.ReferenceEqualityAttribute + ||| WellKnownEntityAttributes.StructuralEqualityAttribute + ||| WellKnownEntityAttributes.NoComparisonAttribute + ||| WellKnownEntityAttributes.CustomComparisonAttribute + ||| WellKnownEntityAttributes.StructuralComparisonAttribute + +/// Match when the augmentation flags are exactly the expected combination (ignoring unrelated attributes). +let (|AugAttribs|_|) (expected: WellKnownEntityAttributes) (flags: WellKnownEntityAttributes) : bool = + flags &&& augmentationAttrMask = expected + +/// Match when a specific augmentation flag is set. +let (|HasAugAttrib|_|) (flag: WellKnownEntityAttributes) (flags: WellKnownEntityAttributes) : bool = + flags &&& flag <> WellKnownEntityAttributes.None + +/// Match when a specific augmentation flag (or flags) is absent. +let (|NoAugAttrib|_|) (flag: WellKnownEntityAttributes) (flags: WellKnownEntityAttributes) : bool = + flags &&& flag = WellKnownEntityAttributes.None + +// Short aliases for the augmentation attribute flags. +let ``[]`` = WellKnownEntityAttributes.NoEqualityAttribute +let ``[]`` = WellKnownEntityAttributes.CustomEqualityAttribute +let ``[]`` = WellKnownEntityAttributes.ReferenceEqualityAttribute +let ``[]`` = WellKnownEntityAttributes.StructuralEqualityAttribute +let ``[]`` = WellKnownEntityAttributes.NoComparisonAttribute +let ``[]`` = WellKnownEntityAttributes.CustomComparisonAttribute +let ``[]`` = WellKnownEntityAttributes.StructuralComparisonAttribute + +// Precomputed combined flag values for exact-match active patterns. +let ``[]`` = ``[]`` ||| ``[]`` +let ``[]`` = ``[]`` ||| ``[]`` +let ``[]`` = ``[]`` ||| ``[]`` +let ``[]`` = ``[]`` ||| ``[]`` +let ``[]`` = ``[]`` ||| ``[]`` +let ``[]`` = ``[]`` ||| ``[]`` +let ``[]`` = ``[]`` ||| ``[]`` + +// Combined masks for "none of these" checks in error cases. +let ``NoComparison or StructuralComparison`` = ``[]`` ||| ``[]`` +let ``NoComparison or CustomComparison`` = ``[]`` ||| ``[]`` +let ``NoEquality or CustomEquality or ReferenceEquality`` = ``[]`` ||| ``[]`` ||| ``[]`` + let getAugmentationAttribs g (tycon: Tycon) = canBeAugmentedWithEquals g tycon, canBeAugmentedWithCompare g tycon, - EntityHasWellKnownAttribute g WellKnownEntityAttributes.NoEqualityAttribute tycon, - EntityHasWellKnownAttribute g WellKnownEntityAttributes.CustomEqualityAttribute tycon, - EntityHasWellKnownAttribute g WellKnownEntityAttributes.ReferenceEqualityAttribute tycon, - EntityHasWellKnownAttribute g WellKnownEntityAttributes.StructuralEqualityAttribute tycon, - EntityHasWellKnownAttribute g WellKnownEntityAttributes.NoComparisonAttribute tycon, - EntityHasWellKnownAttribute g WellKnownEntityAttributes.CustomComparisonAttribute tycon, - EntityHasWellKnownAttribute g WellKnownEntityAttributes.StructuralComparisonAttribute tycon + GetEntityWellKnownFlags g tycon [] type EqualityWithComparerAugmentation = @@ -1055,68 +1094,47 @@ let CheckAugmentationAttribs isImplementation g amap (tycon: Tycon) = match attribs with - // THESE ARE THE LEGITIMATE CASES - - // [< >] on anything - | _, _, false, false, false, false, false, false, false - - // [] on union/record/struct - | true, _, false, true, false, false, false, true, false - - // [] on union/record/struct - | true, _, false, true, false, false, true, false, false -> () + // LEGITIMATE CASES - // [] on union/record/struct - | true, _, false, false, true, false, true, false, false + | _, _, AugAttribs WellKnownEntityAttributes.None + | true, _, AugAttribs ``[]`` + | true, _, AugAttribs ``[]`` -> () - // [] on union/record/struct - | true, _, false, false, true, false, false, false, false -> + | true, _, AugAttribs ``[]`` + | true, _, AugAttribs ``[]`` -> if isTrueFSharpStructTycon g tycon then errorR (Error(FSComp.SR.augNoRefEqualsOnStruct (), m)) else () - // [] on union/record/struct - | true, true, false, false, false, true, false, false, true - - // [] - | true, _, false, false, false, true, true, false, false - - // [] - | true, _, false, false, false, true, false, true, false - - // [] on anything - | _, _, false, false, false, false, true, false, false + | true, true, AugAttribs ``[]`` + | true, _, AugAttribs ``[]`` + | true, _, AugAttribs ``[]`` + | _, _, AugAttribs ``[]`` + | _, _, AugAttribs ``[]`` -> () - // [] on anything - | _, _, true, false, false, false, true, false, false -> () + // ERROR CASES - // THESE ARE THE ERROR CASES + | _, _, HasAugAttrib ``[]`` & NoAugAttrib ``[]`` -> + errorR (Error(FSComp.SR.augNoEqualityNeedsNoComparison (), m)) - // [] - | _, _, true, _, _, _, false, _, _ -> errorR (Error(FSComp.SR.augNoEqualityNeedsNoComparison (), m)) + | true, true, HasAugAttrib ``[]`` & NoAugAttrib ``[]`` -> + errorR (Error(FSComp.SR.augStructCompNeedsStructEquality (), m)) - // [] - | true, true, _, _, _, false, _, _, true -> errorR (Error(FSComp.SR.augStructCompNeedsStructEquality (), m)) - // [] - | true, _, _, _, _, true, false, _, false -> errorR (Error(FSComp.SR.augStructEqNeedsNoCompOrStructComp (), m)) + | true, _, HasAugAttrib ``[]`` & NoAugAttrib ``NoComparison or StructuralComparison`` -> + errorR (Error(FSComp.SR.augStructEqNeedsNoCompOrStructComp (), m)) - // [] - | true, _, _, true, _, _, false, false, _ -> errorR (Error(FSComp.SR.augCustomEqNeedsNoCompOrCustomComp (), m)) + | true, _, HasAugAttrib ``[]`` & NoAugAttrib ``NoComparison or CustomComparison`` -> + errorR (Error(FSComp.SR.augCustomEqNeedsNoCompOrCustomComp (), m)) - // [] - | true, _, _, _, true, true, _, _, _ + | true, _, HasAugAttrib ``[]`` & HasAugAttrib ``[]`` + | true, _, HasAugAttrib ``[]`` & HasAugAttrib ``[]`` -> + errorR (Error(FSComp.SR.augTypeCantHaveRefEqAndStructAttrs (), m)) - // [] - | true, _, _, _, true, _, _, _, true -> errorR (Error(FSComp.SR.augTypeCantHaveRefEqAndStructAttrs (), m)) + | false, _, HasAugAttrib ``[]`` + | false, _, HasAugAttrib ``[]`` + | false, _, HasAugAttrib ``[]`` -> errorR (Error(FSComp.SR.augOnlyCertainTypesCanHaveAttrs (), m)) - // non augmented type, [] - // non augmented type, [] - // non augmented type, [] - | false, _, _, _, true, _, _, _, _ - | false, _, _, _, _, true, _, _, _ - | false, _, _, _, _, _, _, _, true -> errorR (Error(FSComp.SR.augOnlyCertainTypesCanHaveAttrs (), m)) - // All other cases | _ -> errorR (Error(FSComp.SR.augInvalidAttrs (), m)) let hasNominalInterface tcref = @@ -1137,22 +1155,17 @@ let CheckAugmentationAttribs isImplementation g amap (tycon: Tycon) = let hasExplicitGenericEquals = hasNominalInterface g.system_GenericIEquatable_tcref match attribs with - // [] + any equality semantics - | _, _, true, _, _, _, _, _, _ when (hasExplicitEquals || hasExplicitGenericEquals) -> + | _, _, HasAugAttrib ``[]`` when (hasExplicitEquals || hasExplicitGenericEquals) -> warning (Error(FSComp.SR.augNoEqNeedsNoObjEquals (), m)) - // [] + any comparison semantics - | _, _, _, _, _, _, true, _, _ when (hasExplicitICompare || hasExplicitIGenericCompare) -> + | _, _, HasAugAttrib ``[]`` when (hasExplicitICompare || hasExplicitIGenericCompare) -> warning (Error(FSComp.SR.augNoCompCantImpIComp (), m)) - // [] + no explicit override Object.Equals + no explicit IStructuralEquatable - | _, _, _, true, _, _, _, _, _ when isImplementation && not hasExplicitEquals && not hasExplicitGenericEquals -> + | _, _, HasAugAttrib ``[]`` when isImplementation && not hasExplicitEquals && not hasExplicitGenericEquals -> errorR (Error(FSComp.SR.augCustomEqNeedsObjEquals (), m)) - // [] + no explicit IComparable + no explicit IStructuralComparable - | _, _, _, _, _, _, _, true, _ when isImplementation && not hasExplicitICompare && not hasExplicitIGenericCompare -> + | _, _, HasAugAttrib ``[]`` when isImplementation && not hasExplicitICompare && not hasExplicitIGenericCompare -> errorR (Error(FSComp.SR.augCustomCompareNeedsIComp (), m)) - // [] + any equality semantics - | _, _, _, _, true, _, _, _, _ when (hasExplicitEquals || hasExplicitIGenericCompare) -> + | _, _, HasAugAttrib ``[]`` when (hasExplicitEquals || hasExplicitIGenericCompare) -> errorR (Error(FSComp.SR.augRefEqCantHaveObjEquals (), m)) | _ -> () @@ -1164,13 +1177,9 @@ let TyconIsCandidateForAugmentationWithCompare (g: TcGlobals) (tycon: Tycon) = not isUnit && not (isByrefLikeTyconRef g tycon.Range (mkLocalTyconRef tycon)) && match getAugmentationAttribs g tycon with - // [< >] - | true, true, false, false, false, false, false, false, false - // [] - | true, true, false, false, false, true, false, false, true - // [] - | true, true, false, false, false, false, false, false, true -> true - // other cases + | true, true, AugAttribs WellKnownEntityAttributes.None + | true, true, AugAttribs ``[]`` + | true, true, AugAttribs ``[]`` -> true | _ -> false let TyconIsCandidateForAugmentationWithEquals (g: TcGlobals) (tycon: Tycon) = @@ -1182,12 +1191,7 @@ let TyconIsCandidateForAugmentationWithEquals (g: TcGlobals) (tycon: Tycon) = && match getAugmentationAttribs g tycon with - // [< >] - | true, _, false, false, false, false, _, _, _ - // [] - // [] - | true, _, false, false, false, true, _, _, _ -> true - // other cases + | true, _, NoAugAttrib ``NoEquality or CustomEquality or ReferenceEquality`` -> true | _ -> false let TyconIsCandidateForAugmentationWithHash g tycon = diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 2c56bbdb1bd..995071138b5 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -1362,6 +1362,17 @@ type Entity = if changed then x.SetEntityAttribs(wa) result + /// Get the computed well-known attribute flags, computing and caching if needed. + member x.GetWellKnownEntityFlags(computeFlags: Attribs -> WellKnownEntityAttributes) : WellKnownEntityAttributes = + let f = LanguagePrimitives.EnumToValue x.EntityAttribs.Flags + + if f &&& (1uL <<< 63) <> 0uL then + let computed = computeFlags (x.EntityAttribs.AsList()) + x.SetEntityAttribs(WellKnownAttribs(x.EntityAttribs.AsList(), computed)) + computed + else + x.EntityAttribs.Flags + /// Sets the structness of a record or union type definition member x.SetIsStructRecordOrUnion b = let flags = x.entity_flags in x.entity_flags <- EntityFlags(flags.IsPrefixDisplay, flags.IsModuleOrNamespace, flags.PreEstablishedHasDefaultConstructor, flags.HasSelfReferentialConstructor, b) diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index cf9ad99f29b..5925ab69c7c 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -477,6 +477,9 @@ type Entity = /// Check if this entity has a specific well-known attribute, computing and caching flags if needed. member HasWellKnownAttribute: flag: WellKnownEntityAttributes * computeFlags: (Attribs -> WellKnownEntityAttributes) -> bool + /// Get the computed well-known attribute flags, computing and caching if needed. + member GetWellKnownEntityFlags: computeFlags: (Attribs -> WellKnownEntityAttributes) -> WellKnownEntityAttributes + member SetCompiledName: name: string option -> unit member SetExceptionInfo: exn_info: ExceptionInfo -> unit diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index d25a5ec5e6f..4791cc1d429 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3949,6 +3949,10 @@ let attribsHaveEntityFlag g (flag: WellKnownEntityAttributes) (attribs: Attribs) let EntityHasWellKnownAttribute (g: TcGlobals) (flag: WellKnownEntityAttributes) (entity: Entity) : bool = entity.HasWellKnownAttribute(flag, computeEntityWellKnownFlags g) +/// Get the computed well-known attribute flags for an entity. +let GetEntityWellKnownFlags (g: TcGlobals) (entity: Entity) : WellKnownEntityAttributes = + entity.GetWellKnownEntityFlags(computeEntityWellKnownFlags g) + /// Classify a single Val-level attribute, returning its well-known flag (or None). let classifyValAttrib (g: TcGlobals) (attrib: Attrib) : WellKnownValAttributes = let (Attrib(tcref, _, _, _, _, _, _)) = attrib diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 3f842467237..8291ddf07f6 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2456,6 +2456,9 @@ val (|ValAttribString|_|): g: TcGlobals -> flag: WellKnownValAttributes -> attri val EntityHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownEntityAttributes -> entity: Entity -> bool +/// Get the computed well-known attribute flags for an entity. +val GetEntityWellKnownFlags: g: TcGlobals -> entity: Entity -> WellKnownEntityAttributes + /// Map a WellKnownILAttributes flag to its entity flag + provided-type AttribInfo equivalents. val mapILFlag: g: TcGlobals -> flag: WellKnownILAttributes -> struct (WellKnownEntityAttributes * BuiltinAttribInfo option) diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fsi b/src/Compiler/TypedTree/WellKnownAttribs.fsi index 7f7a47c722f..146ce3736a2 100644 --- a/src/Compiler/TypedTree/WellKnownAttribs.fsi +++ b/src/Compiler/TypedTree/WellKnownAttribs.fsi @@ -124,6 +124,7 @@ type internal WellKnownAttribs<'TItem, 'TFlags when 'TFlags: enum> = val private flags: 'TFlags new: attribs: 'TItem list * flags: 'TFlags -> WellKnownAttribs<'TItem, 'TFlags> member AsList: unit -> 'TItem list + member Flags: 'TFlags member HasWellKnownAttribute: flag: 'TFlags -> bool member Add: attrib: 'TItem * flag: 'TFlags -> WellKnownAttribs<'TItem, 'TFlags> member WithRecomputedFlags: unit -> WellKnownAttribs<'TItem, 'TFlags> From d3228b691fcbdc375a81b9f61fbf84ed94eda7bb Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 6 Mar 2026 18:53:20 +0100 Subject: [PATCH 70/71] Fix MarshalAs regression: don't filter attribute before GenMarshal reads it GenParamAttribs was filtering MarshalAsAttribute from the attribs list before passing it to GenMarshal, which then couldn't find the attribute data (UnmanagedType value). Remove MarshalAs from the pre-filter mask and let GenMarshal handle its own filtering. Fixes: Marshal_fs IL baseline test (all platforms) Fixes: attributes-FSC_OPTIMIZED/FSI (Windows Desktop) Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/CodeGen/IlxGen.fs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 9d4507d6794..03327741b1f 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -8987,10 +8987,10 @@ and GenParamAttribs cenv paramTy attribs = &&& (WellKnownValAttributes.InAttribute ||| WellKnownValAttributes.OutAttribute ||| WellKnownValAttributes.OptionalAttribute - ||| WellKnownValAttributes.DefaultParameterValueAttribute - ||| WellKnownValAttributes.MarshalAsAttribute) + ||| WellKnownValAttributes.DefaultParameterValueAttribute) // Filter out IL-implicit attributes in a single pass (only if any are present) + // Note: MarshalAs is NOT filtered here — GenMarshal handles its own filtering. let attribs = if filterMask = WellKnownValAttributes.None then attribs @@ -9002,8 +9002,7 @@ and GenParamAttribs cenv paramTy attribs = (WellKnownValAttributes.InAttribute ||| WellKnownValAttributes.OutAttribute ||| WellKnownValAttributes.OptionalAttribute - ||| WellKnownValAttributes.DefaultParameterValueAttribute - ||| WellKnownValAttributes.MarshalAsAttribute) + ||| WellKnownValAttributes.DefaultParameterValueAttribute) let Marshal, attribs = GenMarshal cenv valFlags attribs inFlag, outFlag, optionalFlag, defaultValue, Marshal, attribs From dc294bb33997c0cde1d1c8409887b2f3ba07aadd Mon Sep 17 00:00:00 2001 From: Tomas Grosup Date: Fri, 6 Mar 2026 19:15:03 +0100 Subject: [PATCH 71/71] Fix fantomas formatting in TypedTree.fsi and TypedTreeOps.fsi Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- src/Compiler/TypedTree/TypedTree.fsi | 6 ++++-- src/Compiler/TypedTree/TypedTreeOps.fsi | 12 +++++------- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index 5925ab69c7c..0cd4bfd2305 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -475,7 +475,8 @@ type Entity = member SetEntityAttribs: WellKnownEntityAttribs -> unit /// Check if this entity has a specific well-known attribute, computing and caching flags if needed. - member HasWellKnownAttribute: flag: WellKnownEntityAttributes * computeFlags: (Attribs -> WellKnownEntityAttributes) -> bool + member HasWellKnownAttribute: + flag: WellKnownEntityAttributes * computeFlags: (Attribs -> WellKnownEntityAttributes) -> bool /// Get the computed well-known attribute flags, computing and caching if needed. member GetWellKnownEntityFlags: computeFlags: (Attribs -> WellKnownEntityAttributes) -> WellKnownEntityAttributes @@ -1996,7 +1997,8 @@ type Val = member SetValAttribs: attribs: WellKnownValAttribs -> unit /// Check if this val has a specific well-known attribute, computing and caching flags if needed. - member HasWellKnownAttribute: flag: WellKnownValAttributes * computeFlags: (Attribs -> WellKnownValAttributes) -> bool + member HasWellKnownAttribute: + flag: WellKnownValAttributes * computeFlags: (Attribs -> WellKnownValAttributes) -> bool /// Set all the data on a value member SetData: tg: ValData -> unit diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 8291ddf07f6..42c0d0b1be4 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -2381,7 +2381,8 @@ val classifyILAttrib: attr: ILAttribute -> WellKnownILAttributes val computeILWellKnownFlags: _g: TcGlobals -> attrs: ILAttributes -> WellKnownILAttributes -val tryFindILAttribByFlag: flag: WellKnownILAttributes -> cattrs: ILAttributes -> (ILAttribElem list * ILAttributeNamedArg list) option +val tryFindILAttribByFlag: + flag: WellKnownILAttributes -> cattrs: ILAttributes -> (ILAttribElem list * ILAttributeNamedArg list) option [] val (|ILAttribDecoded|_|): @@ -2460,7 +2461,8 @@ val EntityHasWellKnownAttribute: g: TcGlobals -> flag: WellKnownEntityAttributes val GetEntityWellKnownFlags: g: TcGlobals -> entity: Entity -> WellKnownEntityAttributes /// Map a WellKnownILAttributes flag to its entity flag + provided-type AttribInfo equivalents. -val mapILFlag: g: TcGlobals -> flag: WellKnownILAttributes -> struct (WellKnownEntityAttributes * BuiltinAttribInfo option) +val mapILFlag: + g: TcGlobals -> flag: WellKnownILAttributes -> struct (WellKnownEntityAttributes * BuiltinAttribInfo option) val computeValWellKnownFlags: g: TcGlobals -> attribs: Attribs -> WellKnownValAttributes @@ -2480,11 +2482,7 @@ val EntityTryGetBoolAttribute: /// Query a three-state bool attribute on a Val. Returns bool option. val ValTryGetBoolAttribute: - g: TcGlobals -> - trueFlag: WellKnownValAttributes -> - falseFlag: WellKnownValAttributes -> - v: Val -> - bool option + g: TcGlobals -> trueFlag: WellKnownValAttributes -> falseFlag: WellKnownValAttributes -> v: Val -> bool option val IsMatchingFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attrib -> bool