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 657f21c52ab..8b7997871da 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md @@ -209,6 +209,7 @@ * 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)) * `[]` adapts opaque callbacks once instead of checking their arity on every call. Lifted recursive methods no longer trigger unrelated file initialization, which could deadlock. ([PR #20422](https://github.com/dotnet/fsharp/pull/20422)) * `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)) * Optimizer: passing a partial application of a non-inline module-level function to an `[]` parameter (e.g. `xs |> Option.map (f a b)`) no longer allocates a per-call `FSharpFunc` closure when a captured argument is non-trivial (a field read, a call). Under optimization the argument is eta-expanded to a lambda with its captured evaluations floated above the binding, so the parameter's uses beta-reduce and the closure is eliminated. Captured arguments are still evaluated exactly once, in their original left-to-right order, and the binding keeps its sequence point. Partial applications of inline/SRTP functions and curried members can still allocate closures. ([PR #20487](https://github.com/dotnet/fsharp/pull/20487)) ### Changed diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index bbf9a775416..a6a2c1781c4 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -2111,8 +2111,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 437b75566ef..364047051ba 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 2022a135075..c6f93ee25fc 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -918,8 +918,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 2b05548dabd..62de85f9d42 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -516,8 +516,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) @@ -703,7 +707,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 // @@ -895,7 +899,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 = @@ -1120,7 +1135,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<_> @@ -1190,6 +1205,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 @@ -1501,9 +1520,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 } @@ -1546,7 +1562,6 @@ type TyconAugmentation = tcaug_adhoc_list=null tcaug_super=None tcaug_interfaces=[] - tcaug_closed=false tcaug_abstract=false } [] @@ -4087,6 +4102,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 @@ -6351,7 +6370,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 @@ -6376,7 +6395,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 @@ -6450,7 +6469,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 [] @@ -6491,7 +6510,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 @@ -6505,7 +6524,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 cd28910d1d4..655a2441537 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -286,6 +286,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 @@ -314,6 +317,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 @@ -455,7 +461,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 @@ -504,6 +510,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 @@ -792,6 +803,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 @@ -904,9 +918,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 } @@ -2506,6 +2517,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 @@ -2781,6 +2797,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 db25b854d2b..df53a1675b4 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.Remapping.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.Remapping.fs @@ -2223,25 +2223,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 8a4f1bd308b..ab2f98b02fe 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.Remapping.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.Remapping.fsi @@ -258,7 +258,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 }