From d2eb7f0c5d8f8ef988789450fbb496233bab88bf Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Wed, 9 Sep 2026 08:57:43 +0200 Subject: [PATCH 1/2] Typed tree: create a type's augmentation on first use An entity now starts with no TyconAugmentation and materialises one atomically on the first TypeContents access, so entities that never gain members hold none. The closed flag moves into EntityFlags, where it is readable without forcing an augmentation into existence, and remapping preserves an absent one. Co-Authored-By: Claude Opus 5 --- src/Compiler/Checking/CheckDeclarations.fs | 3 +- src/Compiler/Checking/InfoReader.fs | 2 +- src/Compiler/Checking/MethodOverrides.fs | 3 +- src/Compiler/TypedTree/TypedTree.fs | 45 +++++++++++++------ src/Compiler/TypedTree/TypedTree.fsi | 27 +++++++++-- .../TypedTree/TypedTreeOps.Remapping.fs | 41 +++++++++-------- .../TypedTree/TypedTreeOps.Remapping.fsi | 2 +- src/Compiler/TypedTree/TypedTreePickle.fs | 5 +-- 8 files changed, 83 insertions(+), 45 deletions(-) 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 } From 33b30174249ba2b44ccdf6f8cbfdde82998f15fc Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Wed, 9 Sep 2026 22:48:03 +0200 Subject: [PATCH 2/2] Release notes Co-Authored-By: Claude Fable 5.1 --- docs/release-notes/.FSharp.Compiler.Service/11.0.100.md | 1 + 1 file changed, 1 insertion(+) 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))