Make ILTypeDef super type calculation lazy (#18005)

Author: DedSec256

docs/release-notes/.FSharp.Compiler.Service/9.0.200.md

@@ -44,5 +44,6 @@
 * Better ranges for #nowarn error reporting; bring back #nowarn warnings for --langVersion:80; add warnings under feature flag ([PR #17871](https://github.com/dotnet/fsharp/pull/17871))
 * Better ranges for #nowarn error reporting; bring back #nowarn warnings for --langVersion:80; add warnings under feature flag ([PR #17871](https://github.com/dotnet/fsharp/pull/17871))
 * CheckAndThrow can be invoked only from within Cancellable context ([PR #18037](https://github.com/dotnet/fsharp/pull/18037))
+* Make ILTypeDef base type calculation lazy. ([PR #18005](https://github.com/dotnet/fsharp/pull/18005))
 
 ### Breaking Changes

src/Compiler/AbstractIL/il.fs

@@ -2562,34 +2562,48 @@ let typeEncodingOfFlags flags =
     elif f = 0x00010000 then ILDefaultPInvokeEncoding.Unicode
     else ILDefaultPInvokeEncoding.Ansi
 
-[<RequireQualifiedAccess>]
-type ILTypeDefKind =
-    | Class
-    | ValueType
-    | Interface
-    | Enum
-    | Delegate
+[<Flags>]
+type ILTypeDefAdditionalFlags =
+    | Class = 1
+    | ValueType = 2
+    | Interface = 4
+    | Enum = 8
+    | Delegate = 16
+    | IsKnownToBeAttribute = 32
+    /// The type can contain extension methods,
+    /// or this information may not be available at the time the ILTypeDef is created
+    | CanContainExtensionMethods = 1024
+
+let internal typeKindFlags =
+    ILTypeDefAdditionalFlags.Class |||
+    ILTypeDefAdditionalFlags.ValueType |||
+    ILTypeDefAdditionalFlags.Interface |||
+    ILTypeDefAdditionalFlags.Enum |||
+    ILTypeDefAdditionalFlags.Delegate
+
+let inline internal resetTypeKind flags =
+    flags &&& ~~~typeKindFlags
+
+let (|HasFlag|_|) (flag: ILTypeDefAdditionalFlags) flags =
+    flags &&& flag = flag
+
+let inline typeKindByNames extendsName typeName =
+    match extendsName with
+    | "System.Enum" -> ILTypeDefAdditionalFlags.Enum
+    | "System.Delegate" when typeName <> "System.MulticastDelegate" -> ILTypeDefAdditionalFlags.Delegate
+    | "System.MulticastDelegate" -> ILTypeDefAdditionalFlags.Delegate
+    | "System.ValueType" when typeName <> "System.Enum" -> ILTypeDefAdditionalFlags.ValueType
+    | _ -> ILTypeDefAdditionalFlags.Class
 
 let typeKindOfFlags nm (super: ILType option) flags =
     if (flags &&& 0x00000020) <> 0x0 then
-        ILTypeDefKind.Interface
+        ILTypeDefAdditionalFlags.Interface
     else
         match super with
-        | None -> ILTypeDefKind.Class
+        | None -> ILTypeDefAdditionalFlags.Class
         | Some ty ->
             let name = ty.TypeSpec.Name
-
-            if name = "System.Enum" then
-                ILTypeDefKind.Enum
-            elif
-                (name = "System.Delegate" && nm <> "System.MulticastDelegate")
-                || name = "System.MulticastDelegate"
-            then
-                ILTypeDefKind.Delegate
-            elif name = "System.ValueType" && nm <> "System.Enum" then
-                ILTypeDefKind.ValueType
-            else
-                ILTypeDefKind.Class
+            typeKindByNames name nm
 
 let convertTypeAccessFlags access =
     match access with
@@ -2605,11 +2619,8 @@ let convertTypeAccessFlags access =
 
 let convertTypeKind kind =
     match kind with
-    | ILTypeDefKind.Class -> TypeAttributes.Class
-    | ILTypeDefKind.ValueType -> TypeAttributes.Class
-    | ILTypeDefKind.Interface -> TypeAttributes.Abstract ||| TypeAttributes.Interface
-    | ILTypeDefKind.Enum -> TypeAttributes.Class
-    | ILTypeDefKind.Delegate -> TypeAttributes.Class
+    | HasFlag ILTypeDefAdditionalFlags.Interface -> TypeAttributes.Abstract ||| TypeAttributes.Interface
+    | _ -> TypeAttributes.Class
 
 let convertLayout layout =
     match layout with
@@ -2638,13 +2649,7 @@ let convertInitSemantics (init: ILTypeInit) =
     | ILTypeInit.BeforeField -> TypeAttributes.BeforeFieldInit
     | ILTypeInit.OnAny -> enum 0
 
-[<Flags>]
-type ILTypeDefAdditionalFlags =
-    | None = 0
-    | IsKnownToBeAttribute = 1
-    /// The type can contain extension methods,
-    /// or this information may not be available at the time the ILTypeDef is created
-    | CanContainExtensionMethods = 2
+let emptyILExtends = notlazy<ILType option> None
 
 [<NoComparison; NoEquality; StructuredFormatDisplay("{DebugText}")>]
 type ILTypeDef
@@ -2654,7 +2659,7 @@ type ILTypeDef
         layout: ILTypeDefLayout,
         implements: InterruptibleLazy<InterfaceImpl list>,
         genericParams: ILGenericParameterDefs,
-        extends: ILType option,
+        extends: InterruptibleLazy<ILType option>,
         methods: ILMethodDefs,
         nestedTypes: ILTypeDefs,
         fields: ILFieldDefs,
@@ -2705,6 +2710,42 @@ type ILTypeDef
             NoMetadataIdx
         )
 
+    new(name,
+        attributes,
+        layout,
+        implements,
+        genericParams,
+        extends,
+        methods,
+        nestedTypes,
+        fields,
+        methodImpls,
+        events,
+        properties,
+        securityDecls,
+        customAttrs) =
+        let additionalFlags =
+            ILTypeDefAdditionalFlags.CanContainExtensionMethods |||
+            typeKindOfFlags name extends (int attributes)
+        ILTypeDef(
+            name,
+            attributes,
+            layout,
+            InterruptibleLazy.FromValue(implements),
+            genericParams,
+            InterruptibleLazy.FromValue(extends),
+            methods,
+            nestedTypes,
+            fields,
+            methodImpls,
+            events,
+            properties,
+            additionalFlags,
+            storeILSecurityDecls securityDecls,
+            customAttrs,
+            NoMetadataIdx
+        )
+
     member _.Name = name
 
     member _.Attributes = attributes
@@ -2786,20 +2827,15 @@ type ILTypeDef
 
     member x.SecurityDecls = x.SecurityDeclsStored.GetSecurityDecls x.MetadataIndex
 
-    member x.IsClass =
-        (typeKindOfFlags x.Name x.Extends (int x.Attributes)) = ILTypeDefKind.Class
+    member x.IsClass = hasFlag ILTypeDefAdditionalFlags.Class
 
-    member x.IsStruct =
-        (typeKindOfFlags x.Name x.Extends (int x.Attributes)) = ILTypeDefKind.ValueType
+    member x.IsStruct = hasFlag ILTypeDefAdditionalFlags.ValueType
 
-    member x.IsInterface =
-        (typeKindOfFlags x.Name x.Extends (int x.Attributes)) = ILTypeDefKind.Interface
+    member x.IsInterface = hasFlag ILTypeDefAdditionalFlags.Interface
 
-    member x.IsEnum =
-        (typeKindOfFlags x.Name x.Extends (int x.Attributes)) = ILTypeDefKind.Enum
+    member x.IsEnum = hasFlag ILTypeDefAdditionalFlags.Enum
 
-    member x.IsDelegate =
-        (typeKindOfFlags x.Name x.Extends (int x.Attributes)) = ILTypeDefKind.Delegate
+    member x.IsDelegate = hasFlag ILTypeDefAdditionalFlags.Delegate
 
     member x.Access = typeAccessOfFlags (int x.Attributes)
     member x.IsAbstract = x.Attributes &&& TypeAttributes.Abstract <> enum 0
@@ -2850,9 +2886,10 @@ type ILTypeDef
     member x.WithKind(kind) =
         x.With(
             attributes = (x.Attributes ||| convertTypeKind kind),
+            newAdditionalFlags = (resetTypeKind additionalFlags ||| kind),
             extends =
                 match kind with
-                | ILTypeDefKind.Interface -> None
+                | HasFlag ILTypeDefAdditionalFlags.Interface -> emptyILExtends
                 | _ -> x.Extends
         )
 
@@ -2865,6 +2902,9 @@ type ILTypeDef
     member x.WithInitSemantics(init) =
         x.With(attributes = (x.Attributes ||| convertInitSemantics init))
 
+    member x.WithIsKnownToBeAttribute() =
+        x.With(newAdditionalFlags = (additionalFlags ||| ILTypeDefAdditionalFlags.IsKnownToBeAttribute))
+
     [<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
     member x.DebugText = x.ToString()
 
@@ -4259,7 +4299,7 @@ let mkILGenericClass (nm, access, genparams, extends, impls, methods, fields, ne
         name = nm,
         attributes = attributes,
         genericParams = genparams,
-        implements = InterruptibleLazy.FromValue(impls),
+        implements = impls,
         layout = ILTypeDefLayout.Auto,
         extends = Some extends,
         methods = methods,
@@ -4269,7 +4309,6 @@ let mkILGenericClass (nm, access, genparams, extends, impls, methods, fields, ne
         methodImpls = emptyILMethodImpls,
         properties = props,
         events = events,
-        additionalFlags = ILTypeDefAdditionalFlags.None,
         securityDecls = emptyILSecurityDecls
     )
 
@@ -4283,7 +4322,7 @@ let mkRawDataValueTypeDef (iltyp_ValueType: ILType) (nm, size, pack) =
              ||| TypeAttributes.ExplicitLayout
              ||| TypeAttributes.BeforeFieldInit
              ||| TypeAttributes.AnsiClass),
-        implements = emptyILInterfaceImpls,
+        implements = [],
         extends = Some iltyp_ValueType,
         layout = ILTypeDefLayout.Explicit { Size = Some size; Pack = Some pack },
         methods = emptyILMethods,
@@ -4293,7 +4332,6 @@ let mkRawDataValueTypeDef (iltyp_ValueType: ILType) (nm, size, pack) =
         methodImpls = emptyILMethodImpls,
         properties = emptyILProperties,
         events = emptyILEvents,
-        additionalFlags = ILTypeDefAdditionalFlags.None,
         securityDecls = emptyILSecurityDecls
     )
 
@@ -5590,7 +5628,7 @@ and refsOfILTypeDef s (td: ILTypeDef) =
     refsOfILTypeDefs s td.NestedTypes
     refsOfILGenericParams s td.GenericParams
     refsOfILTypes s (td.Implements.Value |> List.map _.Type)
-    Option.iter (refsOfILType s) td.Extends
+    Option.iter (refsOfILType s) td.Extends.Value
     refsOfILMethodDefs s td.Methods
     refsOfILFieldDefs s (td.Fields.AsList())
     refsOfILMethodImpls s (td.MethodImpls.AsList())

src/Compiler/AbstractIL/il.fsi

@@ -1483,15 +1483,6 @@ type ILTypeDefAccess =
     | Private
     | Nested of ILMemberAccess
 
-/// A categorization of type definitions into "kinds"
-[<RequireQualifiedAccess>]
-type ILTypeDefKind =
-    | Class
-    | ValueType
-    | Interface
-    | Enum
-    | Delegate
-
 /// Tables of named type definitions.
 [<NoEquality; NoComparison; Class; Sealed>]
 type ILTypeDefs =
@@ -1514,9 +1505,17 @@ type ILTypeDefs =
 
 [<Flags>]
 type ILTypeDefAdditionalFlags =
-    | None = 0
-    | IsKnownToBeAttribute = 1
-    | CanContainExtensionMethods = 2
+    | Class = 1
+    | ValueType = 2
+    | Interface = 4
+    | Enum = 8
+    | Delegate = 16
+    | IsKnownToBeAttribute = 32
+    | CanContainExtensionMethods = 1024
+
+val (|HasFlag|_|): flag: ILTypeDefAdditionalFlags -> flags: ILTypeDefAdditionalFlags -> bool
+
+val inline internal typeKindByNames: extendsName: string -> typeName: string -> ILTypeDefAdditionalFlags
 
 /// Represents IL Type Definitions.
 [<NoComparison; NoEquality>]
@@ -1529,7 +1528,7 @@ type ILTypeDef =
         layout: ILTypeDefLayout *
         implements: InterruptibleLazy<InterfaceImpl list> *
         genericParams: ILGenericParameterDefs *
-        extends: ILType option *
+        extends: InterruptibleLazy<ILType option> *
         methods: ILMethodDefs *
         nestedTypes: ILTypeDefs *
         fields: ILFieldDefs *
@@ -1542,14 +1541,14 @@ type ILTypeDef =
         metadataIndex: int32 ->
             ILTypeDef
 
-    /// Functional creation of a value, immediate
+    /// Functional creation of a value with lazy calculated data
     new:
         name: string *
         attributes: TypeAttributes *
         layout: ILTypeDefLayout *
         implements: InterruptibleLazy<InterfaceImpl list> *
         genericParams: ILGenericParameterDefs *
-        extends: ILType option *
+        extends: InterruptibleLazy<ILType option> *
         methods: ILMethodDefs *
         nestedTypes: ILTypeDefs *
         fields: ILFieldDefs *
@@ -1561,13 +1560,31 @@ type ILTypeDef =
         customAttrs: ILAttributesStored ->
             ILTypeDef
 
+    /// Functional creation of a value, immediate
+    new:
+        name: string *
+        attributes: TypeAttributes *
+        layout: ILTypeDefLayout *
+        implements: InterfaceImpl list *
+        genericParams: ILGenericParameterDefs *
+        extends: ILType option *
+        methods: ILMethodDefs *
+        nestedTypes: ILTypeDefs *
+        fields: ILFieldDefs *
+        methodImpls: ILMethodImplDefs *
+        events: ILEventDefs *
+        properties: ILPropertyDefs *
+        securityDecls: ILSecurityDecls *
+        customAttrs: ILAttributesStored ->
+            ILTypeDef
+
     member Name: string
     member Attributes: TypeAttributes
     member GenericParams: ILGenericParameterDefs
     member Layout: ILTypeDefLayout
     member NestedTypes: ILTypeDefs
     member Implements: InterruptibleLazy<InterfaceImpl list>
-    member Extends: ILType option
+    member Extends: InterruptibleLazy<ILType option>
     member Methods: ILMethodDefs
     member SecurityDecls: ILSecurityDecls
     member Fields: ILFieldDefs
@@ -1605,10 +1622,11 @@ type ILTypeDef =
     member internal WithImport: bool -> ILTypeDef
     member internal WithHasSecurity: bool -> ILTypeDef
     member internal WithLayout: ILTypeDefLayout -> ILTypeDef
-    member internal WithKind: ILTypeDefKind -> ILTypeDef
+    member internal WithKind: ILTypeDefAdditionalFlags -> ILTypeDef
     member internal WithEncoding: ILDefaultPInvokeEncoding -> ILTypeDef
     member internal WithSpecialName: bool -> ILTypeDef
     member internal WithInitSemantics: ILTypeInit -> ILTypeDef
+    member internal WithIsKnownToBeAttribute: unit -> ILTypeDef
 
     /// Functional update
     member With:
@@ -1617,7 +1635,7 @@ type ILTypeDef =
         ?layout: ILTypeDefLayout *
         ?implements: InterruptibleLazy<InterfaceImpl list> *
         ?genericParams: ILGenericParameterDefs *
-        ?extends: ILType option *
+        ?extends: InterruptibleLazy<ILType option> *
         ?methods: ILMethodDefs *
         ?nestedTypes: ILTypeDefs *
         ?fields: ILFieldDefs *
@@ -2257,6 +2275,8 @@ val internal mkILTypeForGlobalFunctions: ILScopeRef -> ILType
 
 val emptyILInterfaceImpls: InterruptibleLazy<InterfaceImpl list>
 
+val emptyILExtends: InterruptibleLazy<ILType option>
+
 /// Making tables of custom attributes, etc.
 val mkILCustomAttrs: ILAttribute list -> ILAttributes
 val mkILCustomAttrsFromArray: ILAttribute[] -> ILAttributes

src/Compiler/AbstractIL/ilmorph.fs

@@ -371,12 +371,14 @@ let rec tdef_ty2ty_ilmbody2ilmbody_mdefs2mdefs isInKnownSet enc fs (tdef: ILType
     let implements =
         tdef.Implements.Value
         |> List.map (fun x -> { x with Type = fTyInCtxtR x.Type })
-        |> InterruptibleLazy.FromValue
+        |> notlazy
+
+    let extends = tdef.Extends.Value |> Option.map fTyInCtxtR |> notlazy
 
     tdef.With(
         implements = implements,
         genericParams = gparams_ty2ty fTyInCtxtR tdef.GenericParams,
-        extends = Option.map fTyInCtxtR tdef.Extends,
+        extends = extends,
         methods = mdefsR,
         nestedTypes = tdefs_ty2ty_ilmbody2ilmbody_mdefs2mdefs isInKnownSet (enc @ [ tdef ]) fs tdef.NestedTypes,
         fields = fdefsR,