Typed tree: create a type's augmentation on first use

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 `[<InlineIfLambda>]` 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))

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

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=

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 &&

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 }
 
     [<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
@@ -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

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<ModuleOrNamespaceType>
@@ -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
 

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<bool * ValRef> | 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<bool * ValRef> | 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

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
 

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
     }