diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index 5d7848f246e..a4c953fc9ad 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -1229,19 +1229,75 @@ type ILAttributes(array: ILAttribute[]) = static member val internal Empty = ILAttributes([||]) -[] -type ILAttributesStored = - - /// Computed by ilread.fs based on metadata index +[] +type WellKnownILAttributes = + | None = 0u + | 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) + | CompilerFeatureRequiredAttribute = (1u <<< 20) + | ExperimentalAttribute = (1u <<< 21) + | RequiredMemberAttribute = (1u <<< 22) + | NullableContextAttribute = (1u <<< 23) + | AttributeUsageAttribute = (1u <<< 24) + | NotComputed = (1u <<< 31) + +type internal ILAttributesStoredRepr = | Reader of (int32 -> ILAttribute[]) - - /// Already computed | Given of ILAttributes - 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 + + [] + let mutable wellKnownFlags = WellKnownILAttributes.NotComputed + + member _.MetadataIndex = metadataIndex + + member x.CustomAttrs: ILAttributes = + match repr with + | Given a -> a + | Reader f -> + let r = ILAttributes(f metadataIndex) + repr <- Given r + r + + member x.HasWellKnownAttribute(flag: WellKnownILAttributes, compute: ILAttributes -> WellKnownILAttributes) : bool = + x.GetOrComputeWellKnownFlags(compute) &&& flag <> WellKnownILAttributes.None + + member x.GetOrComputeWellKnownFlags(compute: ILAttributes -> WellKnownILAttributes) : WellKnownILAttributes = + 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) + + static member CreateGiven(attrs: ILAttributes) = ILAttributesStored(-1, Given attrs) let emptyILCustomAttrs = ILAttributes [||] @@ -1256,18 +1312,18 @@ 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.Reader f +let mkILCustomAttrsReader f = ILAttributesStored.CreateReader(-1, f) type ILCodeLabel = int @@ -1791,7 +1847,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 "" @@ -1809,7 +1865,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 @@ -1870,7 +1926,7 @@ type ILGenericParameterDef = MetadataIndex: int32 } - member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex + member x.CustomAttrs = x.CustomAttrsStored.CustomAttrs /// For debugging [] @@ -1916,13 +1972,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) = { @@ -2029,7 +2079,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 @@ -2266,7 +2316,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( @@ -2342,7 +2392,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) = @@ -2418,7 +2468,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 @@ -2677,8 +2727,6 @@ type ILTypeDef metadataIndex: int32 ) = - let mutable customAttrsStored = customAttrsStored - let hasFlag flag = additionalFlags &&& flag = flag new @@ -2829,13 +2877,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 @@ -2993,7 +3035,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 @@ -3017,7 +3059,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 @@ -3057,7 +3099,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 @@ -3104,7 +3146,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 @@ -3151,7 +3193,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 3d6f88bb6ca..2071b8658e4 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -878,15 +878,45 @@ type ILAttributes = static member internal Empty: ILAttributes +[] +type WellKnownILAttributes = + | None = 0u + | 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) + | 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. -[] +[] type ILAttributesStored = - /// Computed by ilread.fs based on metadata index - | Reader of (int32 -> ILAttribute[]) - /// Already computed - | Given of ILAttributes + member CustomAttrs: ILAttributes + + member HasWellKnownAttribute: flag: WellKnownILAttributes * compute: (ILAttributes -> WellKnownILAttributes) -> bool - member GetCustomAttrs: int32 -> ILAttributes + static member CreateReader: idx: int32 * f: (int32 -> ILAttribute[]) -> ILAttributesStored + static member CreateGiven: attrs: ILAttributes -> ILAttributesStored /// Method parameters and return values. [] 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/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index 9388bc238a8..ba62a69e4be 100755 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -231,13 +231,36 @@ let MethInfoHasAttribute g m attribSpec minfo = (fun _ -> Some ()) |> Option.isSome -let private CheckCompilerFeatureRequiredAttribute (g: TcGlobals) cattrs msg m = +/// 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) = + 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 + +/// 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. // 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 +275,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 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 +294,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,36 +311,38 @@ 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 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 = trackErrors { do! CheckILObsoleteAttributes g isByrefLikeTyconRef cattrs m - do! CheckILExperimentalAttributes g cattrs m + do! CheckILExperimentalAttributes cattrs m } let private extractObsoleteAttributeInfo namedArgs = @@ -334,37 +356,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 +396,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 +407,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)) | _ -> () } @@ -438,45 +449,45 @@ let private CheckProvidedAttributes (g: TcGlobals) m (provAttribs: Tainted - not (Option.isSome (TryDecodeILAttribute isByRefLikeTref cattrs)) - | None -> true +/// Indicate if IL attributes contain 'ObsoleteAttribute'. Used to suppress the item in intellisense. +/// Uses cached well-known flags for O(1) check when ILAttributesStored is available. +/// See also: CheckILAttributesForUnseen for the non-cached variant on ILAttributes. +let CheckILAttributesForUnseenStored (g: TcGlobals) (cattrsStored: ILAttributesStored) = + if cattrsStored.HasWellKnownAttribute(g, WellKnownILAttributes.ObsoleteAttribute) then + not (cattrsStored.HasWellKnownAttribute(g, WellKnownILAttributes.IsByRefLikeAttribute)) else false +/// Indicate if a list of IL attributes contains 'ObsoleteAttribute'. Used to suppress the item in intellisense. +/// Non-cached variant operating on ILAttributes directly. See CheckILAttributesForUnseenStored for cached version. +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. 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. -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. -let CheckFSharpAttributesForUnseen g attribs _m allowObsolete = +let CheckFSharpAttributesForUnseen g attribs allowObsolete = not (isNil attribs) && (not allowObsolete && CheckFSharpAttributesForObsolete g attribs || CheckFSharpAttributesForHidden g attribs) @@ -554,7 +565,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 && (attribsHaveValFlag g WellKnownValAttributes.RequiresExplicitTypeArgumentsAttribute fsAttribs) then do! ErrorD(Error(FSComp.SR.tcFunctionRequiresExplicitTypeArguments(minfo.LogicalName), m)) } @@ -574,8 +585,8 @@ 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 fsAttribs -> Some(CheckFSharpAttributesForUnseen g fsAttribs m allowObsolete)) + (fun ilAttribs -> Some(not allowObsolete && CheckILAttributesForUnseen ilAttribs)) + (fun fsAttribs -> Some(CheckFSharpAttributesForUnseen g fsAttribs allowObsolete)) #if !NO_TYPEPROVIDERS (fun provAttribs -> Some(not allowObsolete && CheckProvidedAttributesForUnseen provAttribs m)) #else @@ -614,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 pinfo.TcGlobals pdef.CustomAttrs m + 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 8a9f0742a23..c8198e4a985 100644 --- a/src/Compiler/Checking/AttributeChecking.fsi +++ b/src/Compiler/Checking/AttributeChecking.fsi @@ -60,15 +60,35 @@ 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 -> + ilFlag: WellKnownILAttributes -> + valFlag: WellKnownValAttributes -> + attribSpec: BuiltinAttribInfo -> + 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: g: TcGlobals -> cattrs: ILAttributes -> _m: 'a -> bool +val CheckILAttributesForUnseen: cattrs: ILAttributes -> 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 @@ -79,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/AugmentWithHashCompare.fs b/src/Compiler/Checking/AugmentWithHashCompare.fs index f24d23f5f98..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, - 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 + 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 - | _, _, None, None, None, None, None, None, None - - // [] on union/record/struct - | true, _, None, Some true, None, None, None, Some true, None - - // [] on union/record/struct - | true, _, None, Some true, None, None, Some true, None, None -> () + // LEGITIMATE CASES - // [] on union/record/struct - | true, _, None, None, Some true, None, Some true, None, None + | _, _, AugAttribs WellKnownEntityAttributes.None + | true, _, AugAttribs ``[]`` + | true, _, AugAttribs ``[]`` -> () - // [] on union/record/struct - | true, _, None, None, Some true, None, None, None, None -> + | true, _, AugAttribs ``[]`` + | true, _, AugAttribs ``[]`` -> 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, _, None, None, None, Some true, Some true, None, None - - // [] - | true, _, None, None, None, Some true, None, Some true, None - - // [] on anything - | _, _, None, None, None, None, Some true, None, None + | true, true, AugAttribs ``[]`` + | true, _, AugAttribs ``[]`` + | true, _, AugAttribs ``[]`` + | _, _, AugAttribs ``[]`` + | _, _, AugAttribs ``[]`` -> () - // [] on anything - | _, _, Some true, None, None, None, Some true, None, None -> () + // ERROR CASES - // THESE ARE THE ERROR CASES + | _, _, HasAugAttrib ``[]`` & NoAugAttrib ``[]`` -> + errorR (Error(FSComp.SR.augNoEqualityNeedsNoComparison (), m)) - // [] - | _, _, Some true, _, _, _, None, _, _ -> errorR (Error(FSComp.SR.augNoEqualityNeedsNoComparison (), m)) + | true, true, HasAugAttrib ``[]`` & NoAugAttrib ``[]`` -> + errorR (Error(FSComp.SR.augStructCompNeedsStructEquality (), m)) - // [] - | true, true, _, _, _, None, _, _, Some true -> errorR (Error(FSComp.SR.augStructCompNeedsStructEquality (), m)) - // [] - | true, _, _, _, _, Some true, None, _, None -> errorR (Error(FSComp.SR.augStructEqNeedsNoCompOrStructComp (), m)) + | true, _, HasAugAttrib ``[]`` & NoAugAttrib ``NoComparison or StructuralComparison`` -> + errorR (Error(FSComp.SR.augStructEqNeedsNoCompOrStructComp (), m)) - // [] - | true, _, _, Some true, _, _, None, None, _ -> errorR (Error(FSComp.SR.augCustomEqNeedsNoCompOrCustomComp (), m)) + | true, _, HasAugAttrib ``[]`` & NoAugAttrib ``NoComparison or CustomComparison`` -> + errorR (Error(FSComp.SR.augCustomEqNeedsNoCompOrCustomComp (), m)) - // [] - | true, _, _, _, Some true, Some true, _, _, _ + | true, _, HasAugAttrib ``[]`` & HasAugAttrib ``[]`` + | true, _, HasAugAttrib ``[]`` & HasAugAttrib ``[]`` -> + errorR (Error(FSComp.SR.augTypeCantHaveRefEqAndStructAttrs (), m)) - // [] - | true, _, _, _, Some true, _, _, _, Some 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, _, _, _, Some true, _, _, _, _ - | false, _, _, _, _, Some true, _, _, _ - | false, _, _, _, _, _, _, _, Some 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 - | _, _, Some true, _, _, _, _, _, _ when (hasExplicitEquals || hasExplicitGenericEquals) -> + | _, _, HasAugAttrib ``[]`` when (hasExplicitEquals || hasExplicitGenericEquals) -> warning (Error(FSComp.SR.augNoEqNeedsNoObjEquals (), m)) - // [] + any comparison semantics - | _, _, _, _, _, _, Some true, _, _ when (hasExplicitICompare || hasExplicitIGenericCompare) -> + | _, _, HasAugAttrib ``[]`` 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 -> + | _, _, HasAugAttrib ``[]`` 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 -> + | _, _, HasAugAttrib ``[]`` when isImplementation && not hasExplicitICompare && not hasExplicitIGenericCompare -> errorR (Error(FSComp.SR.augCustomCompareNeedsIComp (), m)) - // [] + any equality semantics - | _, _, _, _, Some 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, None, None, None, None, None, None, None - // [] - | true, true, None, None, None, Some true, None, None, Some true - // [] - | true, true, None, None, None, None, None, None, Some 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, _, None, None, None, None, _, _, _ - // [] - // [] - | true, _, None, None, None, Some true, _, _, _ -> true - // other cases + | true, _, NoAugAttrib ``NoEquality or CustomEquality or ReferenceEquality`` -> true | _ -> false let TyconIsCandidateForAugmentationWithHash g tycon = @@ -1645,7 +1649,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 80c70d1bcc1..f425f49dafc 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -434,10 +434,12 @@ 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 = hasFlag fieldFlags (WellKnownValAttributes.DefaultValueAttribute_True ||| WellKnownValAttributes.DefaultValueAttribute_False) + let isVolatile = hasFlag fieldFlags WellKnownValAttributes.VolatileFieldAttribute - let isThreadStatic = isThreadOrContextStatic g attrsForField + let isThreadStatic = + hasFlag fieldFlags (WellKnownValAttributes.ThreadStaticAttribute ||| WellKnownValAttributes.ContextStaticAttribute) if isThreadStatic && (not zeroInit || not isStatic) then errorR(Error(FSComp.SR.tcThreadStaticAndContextStaticMustBeStatic(), m)) @@ -730,11 +732,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))) @@ -1406,7 +1408,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 @@ -2085,7 +2087,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_True tcref.Deref && EntityHasWellKnownAttribute g WellKnownEntityAttributes.AbstractClassAttribute tcref.Deref if isStaticClass && g.langVersion.SupportsFeature(LanguageFeature.ErrorReportingOnStaticClasses) then ReportErrorOnStaticClass synMembers match tyconOpt with @@ -2175,7 +2177,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,16 +2194,15 @@ 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)) // 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 +2212,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 @@ -2299,7 +2297,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 +2315,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 @@ -2326,8 +2324,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 +2335,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 -> @@ -2557,12 +2550,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 = 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) //------------------------------------------------------------------------- @@ -2703,7 +2697,7 @@ 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 + attribsHaveEntityFlag cenv.g WellKnownEntityAttributes.MeasureAttribute attrs with _ -> false)) let TypeNamesInMutRecDecls cenv env (compDecls: MutRecShapes) = @@ -2860,12 +2854,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 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 entityFlags = computeEntityWellKnownFlags g attrs + 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 = @@ -2890,14 +2885,18 @@ module EstablishTypeDefinitionCores = | SynTypeDefnSimpleRepr.Record _ | TyconCoreAbbrevThatIsReallyAUnion (hasMeasureAttr, envinner, id) _ | SynTypeDefnSimpleRepr.Union _ -> - HasFSharpAttribute g g.attrib_StructAttribute attrs + hasStructAttr | _ -> false 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 @@ -3193,8 +3192,8 @@ 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 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 @@ -3233,14 +3232,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 @@ -3250,8 +3249,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 @@ -3288,7 +3287,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 @@ -3396,26 +3395,34 @@ module EstablishTypeDefinitionCores = let innerParent = Parent thisTyconRef let thisTyInst, thisTy = generalizeTyconRef g thisTyconRef - let hasAbstractAttr = HasFSharpAttribute g g.attrib_AbstractClassAttribute attrs - let hasSealedAttr = + let entityFlags = computeEntityWellKnownFlags g attrs + 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 + if g.compilingFSharpCore && id.idText = "Unit" then + Some true + elif hasFlag entityFlags WellKnownEntityAttributes.SealedAttribute_True then Some true + elif hasFlag entityFlags WellKnownEntityAttributes.SealedAttribute_False then + Some false else - TryFindFSharpBoolAttribute g g.attrib_SealedAttribute attrs - let hasMeasureAttr = HasFSharpAttribute g g.attrib_MeasureAttribute attrs + 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 = HasFSharpAttribute g g.attrib_MeasureableAttribute attrs + let hasMeasureableAttr = hasFlag entityFlags WellKnownEntityAttributes.MeasureableAttribute - let structLayoutAttr = TryFindFSharpInt32Attribute g g.attrib_StructLayoutAttribute attrs - let hasAllowNullLiteralAttr = TryFindFSharpBoolAttribute g g.attrib_AllowNullLiteralAttribute attrs = Some true + let structLayoutAttr = + match attrs with + | EntityAttribInt g WellKnownEntityAttributes.StructLayoutAttribute v -> Some v + | _ -> None + let hasAllowNullLiteralAttr = hasFlag entityFlags WellKnownEntityAttributes.AllowNullLiteralAttribute_True if hasAbstractAttr then tycon.TypeContents.tcaug_abstract <- true - tycon.entity_attribs <- attrs + tycon.entity_attribs <- WellKnownEntityAttribs.CreateWithFlags(attrs, entityFlags) let noAbstractClassAttributeCheck() = if hasAbstractAttr then errorR (Error(FSComp.SR.tcOnlyClassesCanHaveAbstract(), m)) @@ -3538,7 +3545,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 ] @@ -3570,7 +3577,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 @@ -3714,12 +3721,12 @@ 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 ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.OptionalArgumentAttribute argInfo then if isOptionTy g ty || isValueOptionTy g ty then ty else - match TryFindFSharpAttribute g g.attrib_StructAttribute argInfo.Attribs 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 | _ -> @@ -3729,7 +3736,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)) @@ -3794,7 +3801,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)) @@ -4171,7 +4178,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)) @@ -4807,7 +4814,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 <- typeEntity.EntityAttribs.Add(extensionAttribute, WellKnownEntityAttributes.ExtensionAttribute) | _ -> () vals, env 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/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/CheckComputationExpressions.fs b/src/Compiler/Checking/Expressions/CheckComputationExpressions.fs index 0af55834f8f..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) + 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 4a406192316..72a3e304fcd 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -711,6 +711,14 @@ let UnifyFunctionTypeAndRecover extraInfo (cenv: cenv) denv mFunExpr ty = let resultTy = NewInferenceType g domainTy, resultTy +/// 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 = @@ -1013,14 +1021,14 @@ let TranslateTopArgSynInfo (cenv: cenv) isArg (m: range) tcAttributes (SynArgInf 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 @@ -1333,7 +1341,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 (TryFindILAttribute g.attrib_SetsRequiredMembersAttribute (minfo.GetCustomAttrs())) then + && not (minfo.GetCustomAttrs().HasWellKnownAttribute(WellKnownILAttributes.SetsRequiredMembersAttribute)) + then let requiredProps = [ @@ -1357,10 +1366,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 + | ValAttribInt g WellKnownValAttributes.MethodImplAttribute flags -> (flags &&& 0x8) <> 0x0 + | _ -> false let MakeAndPublishVal (cenv: cenv) env (altActualParent, inSig, declKind, valRecInfo, vscheme, attrs, xmlDoc, konst, isGeneratedEventVal) = @@ -1404,8 +1413,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 hasFlag valFlags WellKnownValAttributes.DllImportAttribute then if inlineFlag = ValInline.Always then errorR(Error(FSComp.SR.tcDllImportStubsCannotBeInlined(), m)) ValInline.Never @@ -1416,7 +1427,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, _, _)) -> @@ -2170,7 +2184,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 + ValHasWellKnownAttribute g WellKnownValAttributes.GeneralizableValueAttribute vref.Deref | Expr.App (expr1, _, _, [], _) -> IsGeneralizableValue g expr1 | Expr.TyChoose (_, b, _) -> IsGeneralizableValue g b @@ -2386,14 +2400,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 () = + hasFlag valFlags WellKnownValAttributes.NoCompilerInliningAttribute 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 () = + hasFlag valFlags WellKnownValAttributes.DllImportAttribute let inlineFlag, reportIncorrectInlineKeywordUsage = // Mutable values may never be inlined @@ -2838,7 +2856,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 @@ -4481,14 +4499,14 @@ 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) - 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 +5249,12 @@ 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 tryGetWarnOnWithoutNullMessage g vref.Attribs with + | Some _ as warnMsg -> { cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = warnMsg } + | None -> cenv + else + cenv // Report information about the 'active recognizer' occurrence to IDE CallNameResolutionSink cenv.tcSink (mLongId, env.NameEnv, item, emptyTyparInst, ItemOccurrence.Pattern, env.eAccessRights) @@ -6555,7 +6576,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 = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.InlineIfLambdaAttribute argInfo if inlineIfLambda then v.SetInlineIfLambda()) { envinner with eLambdaArgInfos = rest } @@ -6702,7 +6723,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 @@ -7285,7 +7306,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)) @@ -9432,11 +9453,10 @@ 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} + match tryGetWarnOnWithoutNullMessage g vref.Attribs with + | Some _ as msg -> { cenv with css.WarnWhenUsingWithoutNullOnAWithNullTarget = msg } | None 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 with css.WarnWhenUsingWithoutNullOnAWithNullTarget = None } | None -> cenv let cenv = @@ -10214,7 +10234,14 @@ 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 = + 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 @@ -11133,14 +11160,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 = hasFlag valAttribFlags WellKnownValAttributes.VolatileFieldAttribute 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 = attribsHaveValFlag g WellKnownValAttributes.StructAttribute retAttribs let argAndRetAttribs = ArgAndRetAttribs(argAttribs, retAttribs) @@ -11157,10 +11186,11 @@ and TcNormalizedBinding declKind (cenv: cenv) env tpenv overallTy safeThisValOpt | _ -> false | _ -> false - if HasFSharpAttribute g g.attrib_DefaultValueAttribute valAttribs && not isZeroMethod then + let hasDefaultValueAttr = hasFlag valAttribFlags (WellKnownValAttributes.DefaultValueAttribute_True ||| WellKnownValAttributes.DefaultValueAttribute_False) + if hasDefaultValueAttr && not isZeroMethod then errorR(Error(FSComp.SR.tcDefaultValueAttributeRequiresVal(), mBinding)) - let isThreadStatic = isThreadOrContextStatic g valAttribs + let isThreadStatic = hasFlag valAttribFlags (WellKnownValAttributes.ThreadStaticAttribute ||| WellKnownValAttributes.ContextStaticAttribute) if isThreadStatic then errorR(DeprecatedThreadStaticBindingWarning mBinding) if isVolatile then @@ -11175,13 +11205,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 + hasFlag valAttribFlags WellKnownValAttributes.DllImportAttribute then errorR(Error(FSComp.SR.tcDllImportNotAllowed(), mBinding)) - if Option.isNone memberFlagsOpt && HasFSharpAttribute g g.attrib_ConditionalAttribute valAttribs then + if Option.isNone memberFlagsOpt && hasFlag valAttribFlags WellKnownValAttributes.ConditionalAttribute then errorR(Error(FSComp.SR.tcConditionalAttributeRequiresMembers(), mBinding)) - if HasFSharpAttribute g g.attrib_EntryPointAttribute valAttribs then + if hasFlag valAttribFlags WellKnownValAttributes.EntryPointAttribute then if Option.isSome memberFlagsOpt then errorR(Error(FSComp.SR.tcEntryPointAttributeRequiresFunctionInModule(), mBinding)) else @@ -11364,7 +11394,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 = + hasFlag valFlags WellKnownValAttributes.LiteralAttribute if hasLiteralAttr then let literalValExpr, _ = TcExpr cenv (MustEqual overallTy) env tpenv synLiteralValExpr @@ -11443,30 +11476,33 @@ 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 - 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 + match tcref.Attribs with + | EntityAttrib g WellKnownEntityAttributes.AttributeUsageAttribute (Attrib(unnamedArgs = [ AttribInt32Arg validOn ])) -> + validOn, inheritedDefault + | EntityAttrib g WellKnownEntityAttributes.AttributeUsageAttribute (Attrib(unnamedArgs = [ AttribInt32Arg validOn; AttribBoolArg(_allowMultiple); AttribBoolArg inherited])) -> + validOn, inherited + | EntityAttrib g WellKnownEntityAttributes.AttributeUsageAttribute _ -> + warning(Error(FSComp.SR.tcUnexpectedConditionInImportedAssembly(), mAttr)) + validOnDefault, inheritedDefault + | _ -> + validOnDefault, inheritedDefault // Determine valid attribute targets let attributeTargets = enum validOn &&& attrTgt @@ -11743,7 +11779,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 attribsHaveValFlag g WellKnownValAttributes.LiteralAttribute attrs -> error(Error(FSComp.SR.tcLiteralAttributeCannotUseActivePattern(), m)) | _ -> @@ -13076,7 +13112,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 = + attribsHaveValFlag g WellKnownValAttributes.LiteralAttribute attrs if hasLiteralAttr then errorR(Error(FSComp.SR.tcLiteralAttributeRequiresConstantValue(), m)) None 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/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 285dfa4fa8c..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 = MethInfoHasAttribute g m 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 57512d88c29..55ab3c9219b 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -97,7 +97,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 -> hasFlag (classifyValAttrib g a) WellKnownValAttributes.StructAttribute | _ -> false) if isValueOptionTy g apReturnTy || hasStructAttribute() then ActivePatternReturnKind.StructTypeWrapper elif isBoolTy g apReturnTy then ActivePatternReturnKind.Boolean @@ -529,7 +529,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 = @@ -544,7 +544,13 @@ 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 + MethInfoHasWellKnownAttributeSpec + g + m + { ILFlag = WellKnownILAttributes.ExtensionAttribute + ValFlag = WellKnownValAttributes.ExtensionAttribute + AttribInfo = g.attrib_ExtensionAttribute } + minfo let GetTyconRefForExtensionMembers minfo (deref: Entity) amap m g = try @@ -1268,7 +1274,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 = @@ -1315,7 +1321,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. @@ -1438,7 +1444,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) @@ -3018,7 +3024,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 @@ -3079,7 +3085,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 @@ -3260,7 +3266,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) @@ -3378,7 +3384,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) | _ -> @@ -3805,7 +3811,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)) @@ -3888,7 +3894,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) @@ -4364,21 +4370,21 @@ 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 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 @@ -4837,7 +4843,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 @@ -5400,7 +5406,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/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index 12b7566db6e..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 @@ -1084,15 +1092,15 @@ module PrintTypes = let g = denv.g // Detect an optional argument - let isOptionalArg = HasFSharpAttribute g g.attrib_OptionalArgumentAttribute argInfo.Attribs + let isOptionalArg = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.OptionalArgumentAttribute argInfo 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 - |> List.filter (fun a -> not (IsMatchingFSharpAttribute g g.attrib_OptionalArgumentAttribute a)) + argInfo.Attribs.AsList() + |> filterOutWellKnownAttribs g WellKnownEntityAttributes.None WellKnownValAttributes.OptionalArgumentAttribute |> layoutAttribsOneline denv attrsLayout ^^ @@ -1113,7 +1121,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 +1371,7 @@ module PrintTastMemberOrVals = if short then for argInfo in argInfos do for _,info in argInfo do - info.Attribs <- [] + info.Attribs <- WellKnownValAttribs.Empty 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 16b29b71ab6..09e95d5bbf1 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 @@ -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,11 +2119,11 @@ 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_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. - 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)) @@ -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,14 +2200,14 @@ 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 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() @@ -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 = @@ -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 @@ -2567,10 +2567,12 @@ let CheckEntityDefn cenv env (tycon: Entity) = errorR(Error(FSComp.SR.chkDuplicateMethodInheritedTypeWithSuffix nm, m)) + // 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 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. @@ -2646,8 +2648,10 @@ 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 = + attribsHaveValFlag g WellKnownValAttributes.DefaultValueAttribute_True f.FieldAttribs + + 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. @@ -2662,8 +2666,10 @@ 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 = + attribsHaveValFlag g WellKnownValAttributes.DefaultValueAttribute_True f.FieldAttribs + + if zeroInitUnsafe then if not (TypeHasDefaultValue g m f.FormalType) then errorR(Error(FSComp.SR.chkValueWithDefaultValueMustHaveDefaultValue(), m)) @@ -2753,7 +2759,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 f6c575cbb4f..5c947bda13c 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) = @@ -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 = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.InlineIfLambdaAttribute sigArgInfo + let implHasInlineIfLambda = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.InlineIfLambdaAttribute implArgInfo 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/TailCallChecks.fs b/src/Compiler/Checking/TailCallChecks.fs index 6a687add26b..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 @@ -63,7 +71,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 = { @@ -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/Checking/TypeHierarchy.fs b/src/Compiler/Checking/TypeHierarchy.fs index 266e44214b2..ec788a3204a 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 + && (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/Checking/import.fs b/src/Compiler/Checking/import.fs index 644d7c2e8a5..8979bab5e77 100644 --- a/src/Compiler/Checking/import.fs +++ b/src/Compiler/Checking/import.fs @@ -208,20 +208,14 @@ 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) = - 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 = @@ -244,7 +238,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 +642,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..b4f800e185a 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 = @@ -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) = @@ -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 @@ -275,20 +274,24 @@ 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 = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.ParamArrayAttribute argInfo let reflArgInfo = - match TryFindFSharpBoolAttributeAssumeFalse g g.attrib_ReflectedDefinitionAttribute argInfo.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 + if ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.ReflectedDefinitionAttribute_True argInfo then + ReflectedArgInfo.Quote true + elif ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.ReflectedDefinitionAttribute_False argInfo 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 + let isCallerSideOptArg = ArgReprInfoHasWellKnownAttribute g WellKnownValAttributes.OptionalAttribute argInfo let optArgInfo = if isCalleeSideOptArg then CalleeSide elif isCallerSideOptArg then - let defaultParameterValueAttribute = TryFindFSharpAttributeOpt g g.attrib_DefaultParameterValueAttribute argInfo.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. @@ -311,9 +314,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 = 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 @@ -321,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 argInfo.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" @@ -441,8 +444,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 +587,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 +630,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,20 +1264,20 @@ 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 - | 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) // 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 @@ -1753,7 +1754,8 @@ 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 = + 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/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 290bba23e4d..03327741b1f 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 - | 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 @@ -863,7 +867,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) @@ -1397,7 +1401,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. @@ -1536,10 +1540,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 @@ -1940,7 +1943,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 @@ -8450,7 +8453,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) } @@ -8814,172 +8817,194 @@ 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 - |> List.filter (IsMatchingFSharpAttributeOpt g g.attrib_MarshalAsAttribute >> not) - - match TryFindFSharpAttributeOpt g g.attrib_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 = let g = cenv.g + let valFlags = computeValWellKnownFlags g attribs let inFlag = - HasFSharpAttribute g g.attrib_InAttribute attribs || isInByrefTy g paramTy + hasFlag valFlags WellKnownValAttributes.InAttribute || isInByrefTy g paramTy let outFlag = - HasFSharpAttribute g g.attrib_OutAttribute attribs || isOutByrefTy g paramTy + hasFlag valFlags WellKnownValAttributes.OutAttribute || isOutByrefTy g paramTy - let optionalFlag = HasFSharpAttributeOpt g g.attrib_OptionalAttribute attribs + let optionalFlag = hasFlag valFlags WellKnownValAttributes.OptionalAttribute let defaultValue = - TryFindFSharpAttributeOpt g g.attrib_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) + 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) - let Marshal, attribs = GenMarshal cenv attribs + // 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 + else + attribs + |> filterOutWellKnownAttribs + g + WellKnownEntityAttributes.None + (WellKnownValAttributes.InAttribute + ||| WellKnownValAttributes.OutAttribute + ||| WellKnownValAttributes.OptionalAttribute + ||| WellKnownValAttributes.DefaultParameterValueAttribute) + + let Marshal, attribs = GenMarshal cenv valFlags attribs inFlag, outFlag, optionalFlag, defaultValue, Marshal, attribs /// Generate IL parameters @@ -9013,7 +9038,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 @@ -9059,7 +9084,9 @@ and GenParams /// Generate IL method return information and GenReturnInfo cenv eenv returnTy ilRetTy (retInfo: ArgReprInfo) : ILReturn = - let marshal, attribs = GenMarshal cenv retInfo.Attribs + 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 = @@ -9156,26 +9183,34 @@ and ComputeFlagFixupsForMemberBinding cenv (v: Val) = and ComputeMethodImplAttribs cenv (_v: Val) attrs = let g = cenv.g + let valFlags = computeValWellKnownFlags g attrs let implflags = - match TryFindFSharpAttribute g g.attrib_MethodImplAttribute attrs with - | Some(Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> flags - | _ -> 0x0 + if hasFlag valFlags WellKnownValAttributes.MethodImplAttribute then + match attrs with + | ValAttribInt g WellKnownValAttributes.MethodImplAttribute flags -> flags + | _ -> 0x0 + else + 0x0 let hasPreserveSigAttr = - match TryFindFSharpAttributeOpt g g.attrib_PreserveSigAttribute attrs with - | Some _ -> true - | _ -> false + 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 - |> List.filter (IsMatchingFSharpAttribute g g.attrib_MethodImplAttribute >> not) - |> List.filter (IsMatchingFSharpAttributeOpt g g.attrib_PreserveSigAttribute >> not) + 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 @@ -9275,7 +9310,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 @@ -9304,7 +9339,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)) @@ -9321,12 +9356,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 + 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)) @@ -9350,17 +9388,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 @@ -9426,7 +9464,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) -> @@ -9560,7 +9598,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 @@ -9630,7 +9668,8 @@ 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 @@ -10378,7 +10417,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 @@ -10898,7 +10937,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 @@ -10966,7 +11007,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 @@ -11024,7 +11065,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 (IsMatchingFSharpAttribute g g.attrib_DebuggerDisplayAttribute) + |> List.partition (fun a -> hasFlag (classifyEntityAttrib g a) WellKnownEntityAttributes.DebuggerDisplayAttribute) let securityAttrs, normalAttrs = normalAttrs @@ -11038,7 +11079,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 @@ -11060,7 +11101,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 ] @@ -11099,7 +11140,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 = @@ -11141,10 +11182,10 @@ 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 + | ValAttribInt g WellKnownValAttributes.FieldOffsetAttribute fieldOffset -> Some fieldOffset + | ValAttrib g WellKnownValAttributes.FieldOffsetAttribute (Attrib(_, _, _, _, _, _, m)) -> + errorR (Error(FSComp.SR.ilFieldOffsetAttributeCouldNotBeDecoded (), m)) None | _ -> None @@ -11158,16 +11199,18 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option ] let ilNotSerialized = - HasFSharpAttributeOpt g g.attrib_NonSerializedAttribute attribs + attribsHaveValFlag g WellKnownValAttributes.NonSerializedAttribute attribs 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 + 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). @@ -11441,7 +11484,7 @@ 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_True tycon) then yield mkILSimpleStorageCtor (Some g.ilg.typ_Object.TypeSpec, ilThisTy, [], [], reprAccess, None, eenv.imports) @@ -11498,8 +11541,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option let tdef, tdefDiscards = let isSerializable = - (TryFindFSharpBoolAttribute g g.attrib_AutoSerializableAttribute tycon.Attribs - <> Some false) + (not (EntityHasWellKnownAttribute g WellKnownEntityAttributes.AutoSerializableAttribute_False tycon)) match tycon.TypeReprInfo with | TILObjectRepr _ -> @@ -11581,8 +11623,31 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option tdef let tdLayout, tdEncoding = - match TryFindFSharpAttribute g g.attrib_StructLayoutAttribute tycon.Attribs with - | Some(Attrib(_, _, [ AttribInt32Arg layoutKind ], namedArgs, _, _, _)) -> + 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 + ILTypeDefLayout.Sequential { Size = Some 1; Pack = Some 0us }, ILDefaultPInvokeEncoding.Ansi + | _ -> ILTypeDefLayout.Auto, ILDefaultPInvokeEncoding.Ansi + + 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 @@ -11611,30 +11676,10 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) : ILTypeRef option | _ -> ILTypeDefLayout.Auto tdLayout, tdEncoding - | Some(Attrib(_, _, _, _, _, _, m)) -> + | EntityAttrib g WellKnownEntityAttributes.StructLayoutAttribute (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.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/Driver/CompilerDiagnostics.fs b/src/Compiler/Driver/CompilerDiagnostics.fs index 69d72578936..b02e053da7e 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.Empty ArgReprInfo.OtherRange = None }) diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index a11231319dd..3b6a3bfef18 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 + 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/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index b5411ab3282..8a3782bcb35 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -328,6 +328,8 @@ + + diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 5dfa4ed720a..7ec2d4e54fe 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -1678,7 +1678,7 @@ let internal mkBoundValueTypedImpl tcGlobals m moduleName name ty = [], [], { - Attribs = [] + Attribs = WellKnownValAttribs.Empty Name = None OtherRange = None } @@ -2204,8 +2204,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)) = - TryFindFSharpAttribute tcGlobals tcGlobals.attrib_EntryPointAttribute value.Attribs - |> Option.map (fun attrib -> value.DisplayName, attrib) + match value.Attribs with + | ValAttrib tcGlobals WellKnownValAttributes.EntryPointAttribute attrib -> Some(value.DisplayName, attrib) + | _ -> None let rec findEntryPointInContents = function diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index 0eba72d17ff..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 @@ -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] diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index 4fe4c7ccee1..48a42e66ff9 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -642,9 +642,23 @@ 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 autoOpenAttrs, ivtAttrs = + let mutable autoOpen = [] + let mutable ivt = [] - let ivtAttrs = topAttrs.assemblyAttrs |> List.choose (List.singleton >> TryFindFSharpStringAttribute tcGlobals tcGlobals.attrib_InternalsVisibleToAttribute) + 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 @@ -806,6 +820,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 = @@ -818,10 +834,26 @@ module IncrementalBuilderHelpers = with exn -> errorRecoveryNoRange exn None - let locale = TryFindFSharpStringAttribute tcGlobals (tcGlobals.FindSysAttrib "System.Reflection.AssemblyCultureAttribute") topAttrs.assemblyAttrs - let assemVerFromAttrib = - TryFindFSharpStringAttribute tcGlobals (tcGlobals.FindSysAttrib "System.Reflection.AssemblyVersionAttribute") topAttrs.assemblyAttrs - |> Option.bind (fun v -> try Some (parseILVersion v) with _ -> 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) + | _ -> () + elif hasFlag flag WellKnownAssemblyAttributes.TypeProviderAssemblyAttribute then + hasTypeProviderAssemblyAttrib <- true + + locale, ver let ver = match assemVerFromAttrib with | None -> tcConfig.version.GetVersionInfo(tcConfig.implicitIncludeDir) @@ -832,11 +864,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 568e43c496f..32854ee041c 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 = @@ -1844,22 +1846,30 @@ type internal TransparentCompiler errorRecoveryNoRange exn None - let locale = - TryFindFSharpStringAttribute - tcGlobals - (tcGlobals.FindSysAttrib "System.Reflection.AssemblyCultureAttribute") - topAttrs.assemblyAttrs - - let assemVerFromAttrib = - TryFindFSharpStringAttribute - tcGlobals - (tcGlobals.FindSysAttrib "System.Reflection.AssemblyVersionAttribute") - topAttrs.assemblyAttrs - |> Option.bind (fun v -> - try - Some(parseILVersion v) - with _ -> - 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) + | _ -> () + elif hasFlag flag WellKnownAssemblyAttributes.TypeProviderAssemblyAttribute then + hasTypeProviderAssemblyAttrib <- true + + locale, ver let ver = match assemVerFromAttrib with @@ -1872,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/Symbols/SymbolHelpers.fs b/src/Compiler/Symbols/SymbolHelpers.fs index fed644eeb61..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 + 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 d7db3ecd192..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=[]; 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=[]; OtherRange=None } + let argInfo: ArgReprInfo = { Name=nmOpt; Attribs=WellKnownValAttribs.Empty; 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 = 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 @@ -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.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 = []; 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) = @@ -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/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index 3e0bdfd0905..ef6e00ffb16 100644 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -1462,17 +1462,12 @@ 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. 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" @@ -1481,89 +1476,39 @@ 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_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" - 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_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" - 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" - 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" 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" - member val attrib_IlExperimentalAttribute = findSysAttrib "System.Diagnostics.CodeAnalysis.ExperimentalAttribute" member g.improveType tcref tinst = improveTy tcref tinst @@ -1904,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 e69bc7b5e80..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,160 +304,58 @@ type internal TcGlobals = member array_tcr_nice: TypedTree.EntityRef - member attrib_AbstractClassAttribute: BuiltinAttribInfo - member attrib_AllowNullLiteralAttribute: BuiltinAttribInfo member attrib_AttributeUsageAttribute: BuiltinAttribInfo member attrib_AutoOpenAttribute: BuiltinAttribInfo - 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 member attrib_CompilationArgumentCountsAttribute: BuiltinAttribInfo member attrib_CompilationMappingAttribute: BuiltinAttribInfo - member attrib_CompilationRepresentationAttribute: BuiltinAttribInfo - member attrib_CompiledNameAttribute: BuiltinAttribInfo - member attrib_CompilerFeatureRequiredAttribute: BuiltinAttribInfo - - member attrib_CompilerMessageAttribute: BuiltinAttribInfo - - member attrib_ComponentModelEditorBrowsableAttribute: BuiltinAttribInfo - member attrib_ConditionalAttribute: BuiltinAttribInfo - 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 - member attrib_DefaultParameterValueAttribute: BuiltinAttribInfo option - member attrib_DefaultValueAttribute: BuiltinAttribInfo member attrib_DllImportAttribute: BuiltinAttribInfo option member attrib_DynamicDependencyAttribute: BuiltinAttribInfo - member attrib_EntryPointAttribute: BuiltinAttribInfo - member attrib_EqualityConditionalOnAttribute: BuiltinAttribInfo - member attrib_ExperimentalAttribute: BuiltinAttribInfo - member attrib_ExtensionAttribute: BuiltinAttribInfo - member attrib_FieldOffsetAttribute: BuiltinAttribInfo - 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 - - member attrib_InternalsVisibleToAttribute: BuiltinAttribInfo - member attrib_IsReadOnlyAttribute: BuiltinAttribInfo member attrib_IsUnmanagedAttribute: BuiltinAttribInfo - member attrib_LiteralAttribute: BuiltinAttribInfo - - member attrib_MarshalAsAttribute: BuiltinAttribInfo option - 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 - member attrib_NullableAttribute: BuiltinAttribInfo - member attrib_NullableAttribute_opt: BuiltinAttribInfo option - member attrib_NullableContextAttribute: BuiltinAttribInfo - 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 - - 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 member attrib_SecurityAttribute: BuiltinAttribInfo option @@ -468,36 +364,14 @@ type internal TcGlobals = member attrib_SecuritySafeCriticalAttribute: BuiltinAttribInfo - member attrib_SetsRequiredMembersAttribute: BuiltinAttribInfo - - member attrib_SkipLocalsInitAttribute: BuiltinAttribInfo - member attrib_DecimalConstantAttribute: BuiltinAttribInfo - member attrib_StructAttribute: BuiltinAttribInfo - - member attrib_StructLayoutAttribute: BuiltinAttribInfo - - member attrib_StructuralComparisonAttribute: BuiltinAttribInfo - - member attrib_StructuralEqualityAttribute: BuiltinAttribInfo - member attrib_SystemObsolete: BuiltinAttribInfo member attrib_IsByRefLikeAttribute_opt: BuiltinAttribInfo option - member attrib_ThreadStaticAttribute: BuiltinAttribInfo option - member attrib_TypeForwardedToAttribute: BuiltinAttribInfo - member attrib_UnverifiableAttribute: BuiltinAttribInfo - - member attrib_VolatileFieldAttribute: BuiltinAttribInfo - - member attrib_WarnOnWithoutNullArgumentAttribute: BuiltinAttribInfo - - member attrib_IlExperimentalAttribute: BuiltinAttribInfo - member attribs_Unsupported: TypedTree.TyconRef list member bitwise_and_info: IntrinsicValRef diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index b08823c2734..995071138b5 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,26 @@ 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 + + /// 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 + + /// 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) @@ -2770,7 +2791,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 } [] @@ -2813,7 +2834,7 @@ type Val = val_member_info = None val_declaring_entity = ParentNone val_xmldocsig = String.Empty - val_attribs = [] } + val_attribs = WellKnownValAttribs.Empty } /// Range of the definition (implementation) of the value, used by Visual Studio member x.DefinitionRange = @@ -2982,9 +3003,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 @@ -3047,9 +3069,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.Empty + /// Get the declared documentation for the value member x.XmlDoc = match x.val_opt_data with @@ -3306,11 +3334,23 @@ 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 } + /// 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 @@ -4627,6 +4667,42 @@ type Measure = | One(range= m) -> m | RationalPower(measure= ms) -> ms.Range +/// Wraps an Attrib list together with cached WellKnownEntityAttributes flags for O(1) lookup. +type WellKnownEntityAttribs = WellKnownAttribs + +module WellKnownEntityAttribs = + /// Shared singleton for entities with no attributes. + let Empty = WellKnownAttribs([], WellKnownEntityAttributes.None) + + /// Create from an attribute list. If empty, flags = None. Otherwise NotComputed. + let Create(attribs: Attrib list) = + if attribs.IsEmpty then + Empty + else + WellKnownAttribs(attribs, WellKnownEntityAttributes.NotComputed) + + /// Create with precomputed flags (used when flags are already known). + 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 = WellKnownAttribs + +module WellKnownValAttribs = + /// Shared singleton for vals with no attributes. + let Empty = WellKnownAttribs([], WellKnownValAttributes.None) + + /// Create from an attribute list. If empty, flags = None. Otherwise NotComputed. + let Create(attribs: Attrib list) = + if attribs.IsEmpty then + Empty + else + WellKnownAttribs(attribs, WellKnownValAttributes.NotComputed) + + /// Create with precomputed flags (used when flags are already known). + let CreateWithFlags(attribs: Attrib list, flags: WellKnownValAttributes) = + WellKnownAttribs(attribs, flags) + type Attribs = Attrib list [] @@ -4981,7 +5057,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. @@ -6132,7 +6208,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.Empty // fetched on demand via est.fs API entity_typars= LazyWithContext.NotLazy [] entity_tycon_repr = repr entity_tycon_tcaug=TyconAugmentation.Create() @@ -6164,7 +6240,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 +6309,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 +6351,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.Empty // fixed up after entity_typars=typars entity_tycon_repr = TNoRepr entity_tycon_tcaug=TyconAugmentation.Create() @@ -6334,7 +6410,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 3fe7c5b1c90..0cd4bfd2305 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,16 @@ 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 + + /// 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 @@ -528,6 +538,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 @@ -1926,7 +1939,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 @@ -1981,6 +1994,12 @@ type Val = member SetAttribs: attribs: Attribs -> unit + 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 @@ -2037,6 +2056,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 @@ -3234,6 +3256,22 @@ type Measure = member Range: range +/// Wraps an Attrib list together with cached WellKnownEntityAttributes flags for O(1) lookup. +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 = WellKnownAttribs + +module WellKnownValAttribs = + val Empty: WellKnownValAttribs + val Create: attribs: Attrib list -> WellKnownValAttribs + val CreateWithFlags: attribs: Attrib list * flags: WellKnownValAttributes -> WellKnownValAttribs + type Attribs = Attrib list [] @@ -3535,7 +3573,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..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 = []; 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 = []; Name = None; OtherRange = None } + let unnamedRetVal: ArgReprInfo = { Attribs = WellKnownValAttribs.Empty; 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.Empty; 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 9ddb334b97d..4791cc1d429 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -3548,10 +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 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 [] let (|ExtractAttribNamedArg|_|) nm args = @@ -3578,67 +3575,590 @@ let (|AttribStringArg|_|) = function AttribExpr(_, Expr.Const (Const.String n, _ let (|AttribElemStringArg|_|) = function ILAttribElem.String(n) -> n | _ -> None -let TryFindFSharpBoolAttributeWithDefault dflt g nm attrs = - match TryFindFSharpAttribute g nm attrs with - | Some(Attrib(_, _, [ ], _, _, _, _)) -> Some dflt - | Some(Attrib(_, _, [ AttribBoolArg b ], _, _, _, _)) -> Some b - | _ -> None +let TryFindILAttribute (AttribInfo (atref, _)) attrs = + HasILAttribute atref attrs -let TryFindFSharpBoolAttribute g nm attrs = TryFindFSharpBoolAttributeWithDefault true g nm attrs -let TryFindFSharpBoolAttributeAssumeFalse g nm attrs = TryFindFSharpBoolAttributeWithDefault false g nm attrs +let IsILAttrib (AttribInfo (builtInAttrRef, _)) attr = isILAttrib builtInAttrRef attr -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 - | _ -> None +let inline hasFlag (flags: ^F) (flag: ^F) : bool when ^F: enum = + let f = LanguagePrimitives.EnumToValue flags + let v = LanguagePrimitives.EnumToValue flag + f &&& v <> 0uL -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 +/// 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 = + let atref = attr.Method.DeclaringType.TypeSpec.TypeRef -let TryFindILAttributeOpt attr attrs = - match attr with - | Some (AttribInfo (atref, _)) -> HasILAttribute atref attrs - | _ -> false + if not atref.Enclosing.IsEmpty then + WellKnownILAttributes.None + else + 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 -let IsILAttrib (AttribInfo (builtInAttrRef, _)) attr = isILAttrib builtInAttrRef attr - + else + match name with + | "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 + | "System.AttributeUsageAttribute" -> WellKnownILAttributes.AttributeUsageAttribute + | _ -> WellKnownILAttributes.None + +/// 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 + +/// 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) -/// Analyze three cases for attributes declared on type definitions: IL-declared attributes, F#-declared attributes and -/// provided attributes. +/// 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 + + 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) + +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 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 + struct (ValueNone, ValueSome nlr.Path) + else + struct (ValueSome nlr.Path, ValueNone) + elif g.compilingFSharpCore then + match tcref.Deref.PublicPath with + | Some(PubPath pp) -> struct (ValueNone, ValueSome pp) + | None -> struct (ValueNone, ValueNone) + else + struct (ValueNone, 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 + +/// 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 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 -> + match path with + | [| "Microsoft"; "FSharp"; "Core"; name |] -> + match name with + | "SealedAttribute" -> + 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" -> + decodeBoolAttribFlag attrib WellKnownEntityAttributes.DefaultAugmentationAttribute_True WellKnownEntityAttributes.DefaultAugmentationAttribute_False WellKnownEntityAttributes.DefaultAugmentationAttribute_True + | "CLIMutableAttribute" -> WellKnownEntityAttributes.CLIMutableAttribute + | "AutoSerializableAttribute" -> + decodeBoolAttribFlag attrib WellKnownEntityAttributes.AutoSerializableAttribute_True WellKnownEntityAttributes.AutoSerializableAttribute_False WellKnownEntityAttributes.AutoSerializableAttribute_True + | "ReflectedDefinitionAttribute" -> WellKnownEntityAttributes.ReflectedDefinitionAttribute + | "AllowNullLiteralAttribute" -> + 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 + 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 + 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 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" -> WellKnownAssemblyAttributes.AutoOpenAttribute + | _ -> WellKnownAssemblyAttributes.None + | [| "Microsoft"; "FSharp"; "Core"; "CompilerServices"; name |] -> + match name with + | "TypeProviderAssemblyAttribute" -> WellKnownAssemblyAttributes.TypeProviderAssemblyAttribute + | _ -> WellKnownAssemblyAttributes.None + | _ -> WellKnownAssemblyAttributes.None + | ValueNone -> WellKnownAssemblyAttributes.None + +// --------------------------------------------------------------- +// Well-Known Attribute APIs — Navigation Guide +// --------------------------------------------------------------- // -// 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 +// 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) + +/// 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 + for attrib in attribs do + flags <- flags ||| classifyEntityAttrib g attrib + flags + +/// 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. +[] +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 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 attribs with + | EntityAttrib g flag (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 + | 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) = + 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. +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 + 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" -> WellKnownValAttributes.EntryPointAttribute + | "LiteralAttribute" -> WellKnownValAttributes.LiteralAttribute + | "ReflectedDefinitionAttribute" -> + decodeBoolAttribFlag attrib WellKnownValAttributes.ReflectedDefinitionAttribute_True WellKnownValAttributes.ReflectedDefinitionAttribute_False WellKnownValAttributes.ReflectedDefinitionAttribute_False + | "RequiresExplicitTypeArgumentsAttribute" -> WellKnownValAttributes.RequiresExplicitTypeArgumentsAttribute + | "DefaultValueAttribute" -> + decodeBoolAttribFlag attrib WellKnownValAttributes.DefaultValueAttribute_True WellKnownValAttributes.DefaultValueAttribute_False WellKnownValAttributes.DefaultValueAttribute_True + | "VolatileFieldAttribute" -> WellKnownValAttributes.VolatileFieldAttribute + | "NoDynamicInvocationAttribute" -> + 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 + | "ValueAsStaticPropertyAttribute" -> WellKnownValAttributes.ValueAsStaticPropertyAttribute + | "TailCallAttribute" -> WellKnownValAttributes.TailCallAttribute + | _ -> 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 + 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 flag attribs = + tryFindAttribByClassifier classifyValAttrib WellKnownValAttributes.None g flag attribs + +/// 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 + +/// Active pattern: extract a single int32 argument from a well-known val attribute. +[] +let (|ValAttribInt|_|) (g: TcGlobals) (flag: WellKnownValAttributes) (attribs: Attribs) = + 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 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). +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 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 = + 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 (entity.HasWellKnownAttribute(trueFlag ||| falseFlag, computeEntityWellKnownFlags g)) then + Option.None + else + 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 + +/// 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 @@ -3674,6 +4194,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 @@ -3682,13 +4226,45 @@ 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 _ -> + 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 struct (entityFlag, _) = mapILFlag g 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 - | 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 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) = @@ -3722,16 +4298,20 @@ 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) = - 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 +// 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 && @@ -5758,9 +6338,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 @@ -5963,7 +6543,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) @@ -5985,7 +6565,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 = @@ -6432,7 +7012,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 @@ -7080,13 +7660,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 @@ -8346,28 +8927,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 @@ -9158,17 +9740,8 @@ 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) = @@ -9220,13 +9793,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 @@ -9235,7 +9808,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 @@ -9243,7 +9816,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 @@ -9335,7 +9908,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 = @@ -9378,7 +9951,8 @@ 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 -> + not (attribsHaveValFlag g WellKnownValAttributes.DefaultValueAttribute_False fld.FieldAttribs)) flds |> List.forall (actualTyOfRecdField (mkTyconRefInst tcref tinst) >> TypeHasDefaultValueAux isNew g m) @@ -9532,11 +10106,13 @@ 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 let MemberIsCompiledAsInstance g parent isExtensionMember (membInfo: ValMemberInfo) attrs = // All extension members are compiled as static members @@ -9547,12 +10123,13 @@ 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 = + hasFlag entityFlags WellKnownEntityAttributes.CompilationRepresentation_Instance + + let explicitStatic = + hasFlag entityFlags WellKnownEntityAttributes.CompilationRepresentation_Static explicitInstance || (membInfo.MemberFlags.IsInstance && not explicitStatic && @@ -9573,16 +10150,14 @@ 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 + EntityHasWellKnownAttribute g WellKnownEntityAttributes.SealedAttribute_True tcref.Deref else // All other F# types, array, byref, tuple types are sealed true 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 @@ -9967,7 +10542,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 @@ -9977,7 +10552,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 @@ -11379,10 +11954,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) @@ -11456,7 +12027,10 @@ 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 = + 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 @@ -11799,8 +12373,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) @@ -11814,7 +12387,7 @@ let tryAddExtensionAttributeIfNotAlreadyPresentForModule match tryFindExtensionAttributeIn (tryFindExtensionAttribute g) with | None -> moduleEntity | Some extensionAttrib -> - { moduleEntity with entity_attribs = extensionAttrib :: moduleEntity.Attribs } + { moduleEntity with entity_attribs = moduleEntity.EntityAttribs.Add(extensionAttrib, WellKnownEntityAttributes.ExtensionAttribute) } let tryAddExtensionAttributeIfNotAlreadyPresentForType (g: TcGlobals) @@ -11831,7 +12404,7 @@ let tryAddExtensionAttributeIfNotAlreadyPresentForType | Some extensionAttrib -> moduleOrNamespaceTypeAccumulator.Value.AllEntitiesByLogicalMangledName.TryFind(typeEntity.LogicalName) |> Option.iter (fun e -> - e.entity_attribs <- extensionAttrib :: e.Attribs + e.entity_attribs <- e.EntityAttribs.Add(extensionAttrib, WellKnownEntityAttributes.ExtensionAttribute) ) typeEntity diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 37655657ed6..42c0d0b1be4 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 @@ -2372,35 +2374,132 @@ val IsILAttrib: BuiltinAttribInfo -> ILAttribute -> bool val TryFindILAttribute: BuiltinAttribInfo -> ILAttributes -> bool -val TryFindILAttributeOpt: BuiltinAttribInfo option -> ILAttributes -> bool +val inline hasFlag: flags: ^F -> flag: ^F -> bool when ^F: enum -val IsMatchingFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attrib -> bool +/// Compute well-known attribute flags for an ILAttributes collection. +val classifyILAttrib: attr: ILAttribute -> WellKnownILAttributes -val IsMatchingFSharpAttributeOpt: TcGlobals -> BuiltinAttribInfo option -> Attrib -> bool +val computeILWellKnownFlags: _g: TcGlobals -> attrs: ILAttributes -> WellKnownILAttributes -val HasFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> bool +val tryFindILAttribByFlag: + flag: WellKnownILAttributes -> cattrs: ILAttributes -> (ILAttribElem list * ILAttributeNamedArg list) option -val HasFSharpAttributeOpt: TcGlobals -> BuiltinAttribInfo option -> Attribs -> bool +[] +val (|ILAttribDecoded|_|): + flag: WellKnownILAttributes -> cattrs: ILAttributes -> (ILAttribElem list * ILAttributeNamedArg list) voption -val TryFindFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> Attrib option +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 + +type ILAttributes with -val TryFindFSharpAttributeOpt: TcGlobals -> BuiltinAttribInfo option -> Attribs -> Attrib option + /// Non-caching (unlike ILAttributesStored.HasWellKnownAttribute which caches). + member HasWellKnownAttribute: flag: WellKnownILAttributes -> bool -val TryFindFSharpBoolAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> bool option +/// Compute well-known attribute flags for an Entity's Attrib list. +val computeEntityWellKnownFlags: g: TcGlobals -> attribs: Attribs -> WellKnownEntityAttributes -val TryFindFSharpBoolAttributeAssumeFalse: TcGlobals -> BuiltinAttribInfo -> Attribs -> bool option +/// Classify a single entity-level attrib to its well-known flag (or None). +val classifyEntityAttrib: g: TcGlobals -> attrib: Attrib -> WellKnownEntityAttributes -val TryFindFSharpStringAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> string option +/// Classify a single val-level attrib to its well-known flag (or None). +val classifyValAttrib: g: TcGlobals -> attrib: Attrib -> WellKnownValAttributes -val TryFindLocalizedFSharpStringAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> string option +/// Classify a single assembly-level attrib to its well-known flag (or None). +val classifyAssemblyAttrib: g: TcGlobals -> attrib: Attrib -> WellKnownAssemblyAttributes -val TryFindFSharpInt32Attribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> int32 option +/// 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 + +[] +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 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 + +[] +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 + +/// 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) + +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 + +/// 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 HasFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> bool + +val TryFindFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> 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) 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 @@ -2410,6 +2509,12 @@ 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 + +/// 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 @@ -2774,8 +2879,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 diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index b5bd769de7f..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 } @@ -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 @@ -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/TypedTree/WellKnownAttribs.fs b/src/Compiler/TypedTree/WellKnownAttribs.fs new file mode 100644 index 00000000000..c05f0207551 --- /dev/null +++ b/src/Compiler/TypedTree/WellKnownAttribs.fs @@ -0,0 +1,169 @@ +// 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_True = (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) + | MeasureableAttribute = (1uL <<< 17) + | SkipLocalsInitAttribute = (1uL <<< 18) + | DebuggerTypeProxyAttribute = (1uL <<< 19) + | ComVisibleAttribute_True = (1uL <<< 20) + | IsReadOnlyAttribute = (1uL <<< 21) + | IsByRefLikeAttribute = (1uL <<< 22) + | ExtensionAttribute = (1uL <<< 23) + | AttributeUsageAttribute = (1uL <<< 24) + | WarnOnWithoutNullArgumentAttribute = (1uL <<< 25) + | AllowNullLiteralAttribute_True = (1uL <<< 26) + | ClassAttribute = (1uL <<< 27) + | InterfaceAttribute = (1uL <<< 28) + | StructAttribute = (1uL <<< 29) + | 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) + | SealedAttribute_False = (1uL <<< 41) + | AllowNullLiteralAttribute_False = (1uL <<< 42) + | CompilerMessageAttribute = (1uL <<< 43) + | ExperimentalAttribute = (1uL <<< 44) + | UnverifiableAttribute = (1uL <<< 45) + | EditorBrowsableAttribute = (1uL <<< 46) + | CompiledNameAttribute = (1uL <<< 47) + | DebuggerDisplayAttribute = (1uL <<< 48) + | NotComputed = (1uL <<< 63) + +/// Flags enum for well-known assembly-level attributes. +[] +type internal WellKnownAssemblyAttributes = + | None = 0uL + | AutoOpenAttribute = (1uL <<< 0) + | 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). +/// 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) + | CLIEventAttribute = (1uL <<< 30) + | NonSerializedAttribute = (1uL <<< 31) + | MethodImplAttribute = (1uL <<< 32) + | PreserveSigAttribute = (1uL <<< 33) + | FieldOffsetAttribute = (1uL <<< 34) + | CompiledNameAttribute = (1uL <<< 35) + | WarnOnWithoutNullArgumentAttribute = (1uL <<< 36) + | 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. +/// 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) + + /// 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)) + + /// 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 + let computed = compute x.attribs + let wa = WellKnownAttribs<'TItem, 'TFlags>(x.attribs, computed) + + struct (LanguagePrimitives.EnumToValue computed &&& LanguagePrimitives.EnumToValue flag + <> 0uL, + wa, + true) + else + struct (x.HasWellKnownAttribute(flag), x, false) diff --git a/src/Compiler/TypedTree/WellKnownAttribs.fsi b/src/Compiler/TypedTree/WellKnownAttribs.fsi new file mode 100644 index 00000000000..146ce3736a2 --- /dev/null +++ b/src/Compiler/TypedTree/WellKnownAttribs.fsi @@ -0,0 +1,133 @@ +// 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_True = (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) + | MeasureableAttribute = (1uL <<< 17) + | SkipLocalsInitAttribute = (1uL <<< 18) + | DebuggerTypeProxyAttribute = (1uL <<< 19) + | ComVisibleAttribute_True = (1uL <<< 20) + | IsReadOnlyAttribute = (1uL <<< 21) + | IsByRefLikeAttribute = (1uL <<< 22) + | ExtensionAttribute = (1uL <<< 23) + | AttributeUsageAttribute = (1uL <<< 24) + | WarnOnWithoutNullArgumentAttribute = (1uL <<< 25) + | AllowNullLiteralAttribute_True = (1uL <<< 26) + | ClassAttribute = (1uL <<< 27) + | InterfaceAttribute = (1uL <<< 28) + | StructAttribute = (1uL <<< 29) + | 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) + | SealedAttribute_False = (1uL <<< 41) + | AllowNullLiteralAttribute_False = (1uL <<< 42) + | CompilerMessageAttribute = (1uL <<< 43) + | ExperimentalAttribute = (1uL <<< 44) + | UnverifiableAttribute = (1uL <<< 45) + | EditorBrowsableAttribute = (1uL <<< 46) + | CompiledNameAttribute = (1uL <<< 47) + | DebuggerDisplayAttribute = (1uL <<< 48) + | NotComputed = (1uL <<< 63) + +/// Flags enum for well-known assembly-level attributes. +[] +type internal WellKnownAssemblyAttributes = + | None = 0uL + | AutoOpenAttribute = (1uL <<< 0) + | 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). +[] +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) + | CLIEventAttribute = (1uL <<< 30) + | NonSerializedAttribute = (1uL <<< 31) + | MethodImplAttribute = (1uL <<< 32) + | PreserveSigAttribute = (1uL <<< 33) + | FieldOffsetAttribute = (1uL <<< 34) + | CompiledNameAttribute = (1uL <<< 35) + | WarnOnWithoutNullArgumentAttribute = (1uL <<< 36) + | 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. +/// 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 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> + + member CheckFlag: + flag: 'TFlags * compute: ('TItem list -> 'TFlags) -> struct (bool * WellKnownAttribs<'TItem, 'TFlags> * bool) 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 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..df6dca7e61e 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/CustomAttributes/AttributeUsage/AttributeUsage.fs @@ -977,4 +977,54 @@ type Q2 = struct end type Q3 = struct end """ |> typecheck - |> shouldSucceed \ No newline at end of file + |> 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") + ] + 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 bcd92aa0b00..40888f76de1 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,11 @@ 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: 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: 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 get_CustomAttrs() +FSharp.Compiler.AbstractIL.IL+ILAttributesStored: ILAttributesStored CreateGiven(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+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 +1813,34 @@ 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 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 +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 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) FSharp.Compiler.AbstractIL.IL: FSharp.Compiler.AbstractIL.IL+ILArgConvention FSharp.Compiler.AbstractIL.IL: FSharp.Compiler.AbstractIL.IL+ILArrayShape @@ -1891,6 +1905,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]) diff --git a/tests/projects/CompilerCompat/CompilerCompatApp/Program.fs b/tests/projects/CompilerCompat/CompilerCompatApp/Program.fs index 3463bb05d20..b643a77c711 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 sealedObj = CompilerCompatLib.Library.SealedType() + printfn "Sealed: %d" sealedObj.Value + + 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 + 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..085a50e99a8 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