diff --git a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md index ed1e382d6c7..2971bf6c53b 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md @@ -194,6 +194,7 @@ * Make Entity's adhoc members list lazy ([PR #20286](https://github.com/dotnet/fsharp/pull/20286/changes)) * Constraint solver: `TryD` is now `inline` with `[]` on its always-run continuation, so the argument closures are no longer allocated at the (very hot) constraint-solver call sites; `IgnoreFailedMemberConstraintResolution` is `inline` so its forwarded continuation stays a literal. ([PR #20367](https://github.com/dotnet/fsharp/pull/20367)) * `DelayedILModuleReader` no longer boxes its cached `ILModuleReader` on every read: the field is typed `ILModuleReader | null` and matched directly. ([PR #20413](https://github.com/dotnet/fsharp/pull/20413)) +* Typed tree: create a type's augmentation on first use ([PR #20494](https://github.com/dotnet/fsharp/pull/20494)) ### Changed * The `--warnaserror` option now ignores unrecognized diagnostic identifiers in warning lists while still applying recognized F# warning codes. ([PR #20246](https://github.com/dotnet/fsharp/pull/20246)) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index c663b819996..2c26491a021 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -2114,8 +2114,7 @@ let TcMutRecDefns_Phase2 (cenv: cenv) envInitial mBinds scopem mutRecNSInfo (env // Some preliminary checks mutRecDefns |> MutRecShapes.iterTycons (fun tyconData -> let (MutRecDefnsPhase2DataForTycon(_, _, declKind, tcref, _, _, _, members, m, newslotsOK, _)) = tyconData - let tcaug = tcref.TypeContents - if tcaug.tcaug_closed && declKind <> ExtrinsicExtensionBinding then + if tcref.IsAugmentationClosed && declKind <> ExtrinsicExtensionBinding then error(InternalError("Intrinsic augmentations of types are only permitted in the same file as the definition of the type", m)) for mem in members do match mem with diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index e77ad4150de..9ee05f2a612 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/src/Compiler/Checking/InfoReader.fs @@ -741,7 +741,7 @@ type InfoReader(g: TcGlobals, amap: ImportMap) as this = // It would matter for different generic instantiations of the same type, but we don't cache that here - TType_app is always matched for `[]` typars. canMemoize=(fun (_flags, _: range, ty) -> match stripTyEqns g ty with - | TType_app(tcref, [], _) -> tcref.TypeContents.tcaug_closed + | TType_app(tcref, [], _) -> tcref.IsAugmentationClosed | _ -> false), keyComparer= diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index c1cdd1d34b2..e2764fcdf73 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -928,8 +928,7 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader: InfoReader, nenv let g = infoReader.g let amap = infoReader.amap - let tcaug = tycon.TypeContents - tcaug.tcaug_closed <- true + tycon.SetAugmentationClosed() // Note you only have to explicitly implement 'System.IComparable' to customize structural comparison AND equality on F# types if isImplementation && diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 2e8762c04f0..14c6505eb5a 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -512,8 +512,12 @@ type EntityFlags(flags: int64) = | false -> 0b000100000000000L) EntityFlags flags + member x.IsAugmentationClosed = (flags &&& 0b001000000000000L) <> 0x0L + + member x.WithIsAugmentationClosed = EntityFlags(flags ||| 0b001000000000000L) + /// Get the flags as included in the F# binary metadata - member x.PickledBits = (flags &&& ~~~0b000111111000100L) + member x.PickledBits = (flags &&& ~~~0b001111111000100L) @@ -699,7 +703,7 @@ type Entity = /// The methods and properties of the type // // MUTABILITY; used only during creation and remapping of tycons - mutable entity_tycon_tcaug: TyconAugmentation + mutable entity_tycon_tcaug: TyconAugmentation | null /// This field is used when the 'tycon' is really a module definition. It holds statically nested type definitions and nested modules // @@ -891,7 +895,18 @@ type Entity = member x.ModuleOrNamespaceType = x.entity_modul_type.Force() /// The logical contents of the entity when it is a type definition. - member x.TypeContents = x.entity_tycon_tcaug + member x.TypeContents = + match x.entity_tycon_tcaug with + | null -> + let fresh: TyconAugmentation = TyconAugmentation.Create() + + let prior: TyconAugmentation | null = + System.Threading.Interlocked.CompareExchange(&x.entity_tycon_tcaug, fresh, Unchecked.defaultof<_>) + + match prior with + | null -> fresh + | prior -> prior + | tcaug -> tcaug /// The kind of the type definition - is it a measure definition or a type definition? member x.TypeOrMeasureKind = @@ -1116,7 +1131,7 @@ type Entity = entity_range = Unchecked.defaultof<_> entity_attribs = Unchecked.defaultof<_> entity_tycon_repr= Unchecked.defaultof<_> - entity_tycon_tcaug= Unchecked.defaultof<_> + entity_tycon_tcaug= null entity_modul_type= Unchecked.defaultof<_> entity_cpath = Unchecked.defaultof<_> entity_il_repr_cache = Unchecked.defaultof<_> @@ -1186,6 +1201,10 @@ type Entity = | TFSharpTyconRepr { fsobjmodel_kind=TFSharpUnion } -> x.entity_flags.IsStructRecordOrUnionType | _ -> false + member x.IsAugmentationClosed = x.entity_flags.IsAugmentationClosed + + member x.SetAugmentationClosed() = x.entity_flags <- x.entity_flags.WithIsAugmentationClosed + /// The on-demand analysis about whether the entity has the IsByRefLike attribute member x.TryIsByRefLike = x.entity_flags.TryIsByRefLike @@ -1514,9 +1533,6 @@ type TyconAugmentation = /// Super type, if any mutable tcaug_super: TType option - /// Set to true at the end of the scope where proper augmentations are allowed - mutable tcaug_closed: bool - /// Set to true if the type is determined to be abstract mutable tcaug_abstract: bool } @@ -1559,7 +1575,6 @@ type TyconAugmentation = tcaug_adhoc_list=null tcaug_super=None tcaug_interfaces=[] - tcaug_closed=false tcaug_abstract=false } [] @@ -4102,6 +4117,10 @@ type EntityRef = /// it is better to use more specific predicates. member x.IsFSharpObjectModelTycon = x.Deref.IsFSharpObjectModelTycon + member x.IsAugmentationClosed = x.Deref.IsAugmentationClosed + + member x.SetAugmentationClosed() = x.Deref.SetAugmentationClosed() + /// The on-demand analysis about whether the entity has the IsByRefLike attribute member x.TryIsByRefLike = x.Deref.TryIsByRefLike @@ -6364,7 +6383,7 @@ type Construct() = entity_attribs=WellKnownEntityAttribs.Empty // fetched on demand via est.fs API entity_typars= LazyWithContext.NotLazy [] entity_tycon_repr = repr - entity_tycon_tcaug=TyconAugmentation.Create() + entity_tycon_tcaug = null entity_modul_type = MaybeLazy.Lazy(InterruptibleLazy(fun _ -> ModuleOrNamespaceType(Namespace true, QueueList.ofList [], QueueList.ofList []))) // Generated types get internal accessibility entity_cpath = Some cpath @@ -6389,7 +6408,7 @@ type Construct() = entity_flags=EntityFlags(usesPrefixDisplay=false, isModuleOrNamespace=true, preEstablishedHasDefaultCtor=false, hasSelfReferentialCtor=false, isStructRecordOrUnionType=false) entity_typars=LazyWithContext.NotLazy [] entity_tycon_repr = TNoRepr - entity_tycon_tcaug=TyconAugmentation.Create() + entity_tycon_tcaug=null entity_cpath=cpath entity_attribs=WellKnownEntityAttribs.Create(attribs) entity_il_repr_cache = null @@ -6463,7 +6482,7 @@ type Construct() = entity_attribs = WellKnownEntityAttribs.Create(attribs) entity_logical_name = id.idText entity_range = id.idRange - entity_tycon_tcaug = TyconAugmentation.Create() + entity_tycon_tcaug = null entity_modul_type = MaybeLazy.Strict (Construct.NewEmptyModuleOrNamespaceType ModuleOrType) entity_cpath = cpath entity_typars = LazyWithContext.NotLazy [] @@ -6504,7 +6523,7 @@ type Construct() = entity_attribs=WellKnownEntityAttribs.Empty // fixed up after entity_typars=typars entity_tycon_repr = TNoRepr - entity_tycon_tcaug=TyconAugmentation.Create() + entity_tycon_tcaug = null entity_modul_type = mtyp entity_cpath = cpath entity_il_repr_cache = null @@ -6518,7 +6537,7 @@ type Construct() = let tycon = Construct.NewTycon(nlpath, nm, m, taccessPublic, taccessPublic, TyparKind.Type, tps, XmlDoc.Empty, true, false, false, mtyp) tycon.entity_tycon_repr <- TILObjectRepr (TILObjectReprData (scoref, enc, tdef)) - tycon.TypeContents.tcaug_closed <- true + tycon.SetAugmentationClosed() tycon /// Create a new Val node diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index d706237e468..4b8124d787b 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -284,6 +284,9 @@ type EntityFlags = new: flags: int64 -> EntityFlags + /// Mark the entity's augmentation closed + member WithIsAugmentationClosed: EntityFlags + /// Adjust the on-demand analysis about whether the entity is assumed to be a readonly struct member WithIsAssumedReadOnly: flag: bool -> EntityFlags @@ -312,6 +315,9 @@ type EntityFlags = /// These two bits represents the on-demand analysis about whether the entity is assumed to be a readonly struct member TryIsAssumedReadOnly: bool voption + /// Indicates no further members can be added to this entity's augmentation + member IsAugmentationClosed: bool + /// These two bits represents the on-demand analysis about whether the entity has the IsByRefLike attribute member TryIsByRefLike: bool voption @@ -453,7 +459,7 @@ type Entity = mutable entity_tycon_repr: TyconRepresentation /// The methods type properties of the type - mutable entity_tycon_tcaug: TyconAugmentation + mutable entity_tycon_tcaug: TyconAugmentation | null /// This field is used when the 'tycon' is really a module definition. It holds statically nested type definitions type nested modules mutable entity_modul_type: MaybeLazy @@ -509,6 +515,11 @@ type Entity = /// Set the on-demand analysis about whether the entity is assumed to be a readonly struct member SetIsAssumedReadOnly: b: bool -> unit + /// Indicates no further members can be added to this entity's augmentation + member IsAugmentationClosed: bool + + member SetAugmentationClosed: unit -> unit + /// Set the on-demand analysis about whether the entity has the IsByRefLike attribute member SetIsByRefLike: b: bool -> unit @@ -797,6 +808,9 @@ type Entity = /// These two bits represents the on-demand analysis about whether the entity is assumed to be a readonly struct member TryIsAssumedReadOnly: bool voption + /// Indicates no further members can be added to this entity's augmentation + member IsAugmentationClosed: bool + /// The on-demand analysis about whether the entity has the IsByRefLike attribute member TryIsByRefLike: bool voption @@ -909,9 +923,6 @@ type TyconAugmentation = /// Super type, if any mutable tcaug_super: TType option - /// Set to true at the end of the scope where proper augmentations are allowed - mutable tcaug_closed: bool - /// Set to true if the type is determined to be abstract mutable tcaug_abstract: bool } @@ -2513,6 +2524,11 @@ type EntityRef = /// Set the on-demand analysis about whether the entity is assumed to be a readonly struct member SetIsAssumedReadOnly: b: bool -> unit + /// Indicates no further members can be added to this entity's augmentation + member IsAugmentationClosed: bool + + member SetAugmentationClosed: unit -> unit + /// Set the on-demand analysis about whether the entity has the IsByRefLike attribute member SetIsByRefLike: b: bool -> unit @@ -2788,6 +2804,9 @@ type EntityRef = /// The on-demand analysis about whether the entity is assumed to be a readonly struct member TryIsAssumedReadOnly: bool voption + /// Indicates no further members can be added to this entity's augmentation + member IsAugmentationClosed: bool + /// The on-demand analysis about whether the entity has the IsByRefLike attribute member TryIsByRefLike: bool voption diff --git a/src/Compiler/TypedTree/TypedTreeOps.Remapping.fs b/src/Compiler/TypedTree/TypedTreeOps.Remapping.fs index 92d440d6f6d..6973934d13d 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.Remapping.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.Remapping.fs @@ -2183,25 +2183,28 @@ module internal ExprRemapping = | TAsmRepr _ -> repr | TMeasureableRepr x -> TMeasureableRepr(remapType tmenv x) - and remapTyconAug tmenv (x: TyconAugmentation) = - { x with - tcaug_equals = x.tcaug_equals |> Option.map (mapPair (remapValRef tmenv, remapValRef tmenv)) - tcaug_compare = x.tcaug_compare |> Option.map (mapPair (remapValRef tmenv, remapValRef tmenv)) - tcaug_compare_withc = x.tcaug_compare_withc |> Option.map (remapValRef tmenv) - tcaug_hash_and_equals_withc = - x.tcaug_hash_and_equals_withc - |> Option.map (mapQuadruple (remapValRef tmenv, remapValRef tmenv, remapValRef tmenv, Option.map (remapValRef tmenv))) - tcaug_adhoc = x.tcaug_adhoc |> NameMap.map (List.map (remapValRef tmenv)) - tcaug_adhoc_list = - let remapped: ResizeArray | null = - match x.tcaug_adhoc_list with - | null -> null - | l -> l |> ResizeArray.map (fun (flag, vref) -> (flag, remapValRef tmenv vref)) - - remapped - tcaug_super = x.tcaug_super |> Option.map (remapType tmenv) - tcaug_interfaces = x.tcaug_interfaces |> List.map (map1Of3 (remapType tmenv)) - } + and remapTyconAug tmenv (x: TyconAugmentation | null) : TyconAugmentation | null = + match x with + | null -> null + | x -> + { x with + tcaug_equals = x.tcaug_equals |> Option.map (mapPair (remapValRef tmenv, remapValRef tmenv)) + tcaug_compare = x.tcaug_compare |> Option.map (mapPair (remapValRef tmenv, remapValRef tmenv)) + tcaug_compare_withc = x.tcaug_compare_withc |> Option.map (remapValRef tmenv) + tcaug_hash_and_equals_withc = + x.tcaug_hash_and_equals_withc + |> Option.map (mapQuadruple (remapValRef tmenv, remapValRef tmenv, remapValRef tmenv, Option.map (remapValRef tmenv))) + tcaug_adhoc = x.tcaug_adhoc |> NameMap.map (List.map (remapValRef tmenv)) + tcaug_adhoc_list = + let remapped: ResizeArray | null = + match x.tcaug_adhoc_list with + | null -> null + | l -> l |> ResizeArray.map (fun (flag, vref) -> (flag, remapValRef tmenv vref)) + + remapped + tcaug_super = x.tcaug_super |> Option.map (remapType tmenv) + tcaug_interfaces = x.tcaug_interfaces |> List.map (map1Of3 (remapType tmenv)) + } and remapTyconExnInfo ctxt tmenv inp = match inp with diff --git a/src/Compiler/TypedTree/TypedTreeOps.Remapping.fsi b/src/Compiler/TypedTree/TypedTreeOps.Remapping.fsi index 5372d2a2511..8b366a0eca0 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.Remapping.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.Remapping.fsi @@ -253,7 +253,7 @@ module internal ExprRemapping = val remapTyconRepr: RemapContext -> Remap -> TyconRepresentation -> TyconRepresentation - val remapTyconAug: Remap -> TyconAugmentation -> TyconAugmentation + val remapTyconAug: Remap -> (TyconAugmentation | null) -> TyconAugmentation | null val remapTyconExnInfo: RemapContext -> Remap -> ExceptionInfo -> ExceptionInfo diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index 9d599189afe..b52113463c3 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -2840,7 +2840,7 @@ and p_entity_spec_data (x: Entity) 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 + p_tcaug x.TypeContents st p_string System.String.Empty st p_kind x.TypeOrMeasureKind st @@ -3195,7 +3195,7 @@ and u_entity_spec_data st : Entity = entity_attribs = WellKnownEntityAttribs.Create(x6) entity_tycon_repr = x7 entity_tycon_tcaug = x9 - entity_flags = EntityFlags x11 + entity_flags = (EntityFlags x11).WithIsAugmentationClosed entity_cpath = x12 entity_modul_type = MaybeLazy.Lazy x13 entity_il_repr_cache = newCache () @@ -3245,7 +3245,6 @@ and u_tcaug st = tcaug_interfaces = d tcaug_super = e // pickled type definitions are always closed (i.e. no more intrinsic members allowed) - tcaug_closed = true tcaug_abstract = g }