Make ILTypeDef interface calculation lazy

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

@@ -52,7 +52,7 @@
 * Better CE error reporting when using `use!` with `and!` ([PR #17671](https://github.com/dotnet/fsharp/pull/17671))
 * Better error reporting for let bindings. ([PR #17601](https://github.com/dotnet/fsharp/pull/17601))
 * Optimize ILTypeDef interface impls reading from metadata. ([PR #17382](https://github.com/dotnet/fsharp/pull/17382))
+* Make ILTypeDef interface impls calculation lazy. ([PR #17392](https://github.com/dotnet/fsharp/pull/17392))
 * Better error reporting for active patterns. ([PR #17666](https://github.com/dotnet/fsharp/pull/17666))
 
-
 ### Breaking Changes

src/Compiler/AbstractIL/il.fs

@@ -1909,6 +1909,23 @@ let inline conditionalAdd condition flagToAdd source =
 
 let NoMetadataIdx = -1
 
+type InterfaceImpl =
+    { Idx: int; Type: ILType; mutable CustomAttrsStored: ILAttributesStored }
+
+    member x.CustomAttrs =
+        match x.CustomAttrsStored with
+        | ILAttributesStored.Reader f ->
+            let res = ILAttributes(f x.Idx)
+            x.CustomAttrsStored <- ILAttributesStored.Given res
+            res
+        | ILAttributesStored.Given attrs -> attrs
+
+    static member Create(ilType: ILType, customAttrsStored: ILAttributesStored) =
+        { Idx = NoMetadataIdx; Type = ilType; CustomAttrsStored = customAttrsStored }
+
+    static member Create(ilType: ILType) = InterfaceImpl.Create(ilType, emptyILCustomAttrsStored)
+
+
 [<NoComparison; NoEquality; StructuredFormatDisplay("{DebugText}")>]
 type ILMethodDef
     (
@@ -2635,8 +2652,7 @@ type ILTypeDef
         name: string,
         attributes: TypeAttributes,
         layout: ILTypeDefLayout,
-        implements: ILTypes,
-        implementsCustomAttrs: (ILAttributesStored * int) list option,
+        implements: InterruptibleLazy<InterfaceImpl list>,
         genericParams: ILGenericParameterDefs,
         extends: ILType option,
         methods: ILMethodDefs,
@@ -2659,7 +2675,6 @@ type ILTypeDef
         attributes,
         layout,
         implements,
-        implementsCustomAttrs,
         genericParams,
         extends,
         methods,
@@ -2676,7 +2691,6 @@ type ILTypeDef
             attributes,
             layout,
             implements,
-            implementsCustomAttrs,
             genericParams,
             extends,
             methods,
@@ -2703,8 +2717,6 @@ type ILTypeDef
 
     member _.Implements = implements
 
-    member _.ImplementsCustomAttrs = implementsCustomAttrs
-
     member _.Extends = extends
 
     member _.Methods = methods
@@ -2744,8 +2756,7 @@ type ILTypeDef
             ?properties,
             ?newAdditionalFlags,
             ?customAttrs,
-            ?securityDecls,
-            ?implementsCustomAttrs
+            ?securityDecls
         ) =
         ILTypeDef(
             name = defaultArg name x.Name,
@@ -2754,7 +2765,6 @@ type ILTypeDef
             genericParams = defaultArg genericParams x.GenericParams,
             nestedTypes = defaultArg nestedTypes x.NestedTypes,
             implements = defaultArg implements x.Implements,
-            implementsCustomAttrs = defaultArg implementsCustomAttrs x.ImplementsCustomAttrs,
             extends = defaultArg extends x.Extends,
             methods = defaultArg methods x.Methods,
             securityDecls = defaultArg securityDecls x.SecurityDecls,
@@ -3333,6 +3343,8 @@ let mkILTypeDefs l = mkILTypeDefsFromArray (Array.ofList l)
 let mkILTypeDefsComputed f = ILTypeDefs f
 let emptyILTypeDefs = mkILTypeDefsFromArray [||]
 
+let emptyILInterfaceImpls = InterruptibleLazy<InterfaceImpl list>.FromValue([])
+
 // --------------------------------------------------------------------
 // Operations on method tables.
 // --------------------------------------------------------------------
@@ -4240,7 +4252,7 @@ let mkILSimpleStorageCtor (baseTySpec, ty, extraParams, flds, access, tag, impor
 let mkILStorageCtor (preblock, ty, flds, access, tag, imports) =
     mkILStorageCtorWithParamNames (preblock, ty, [], addParamNames flds, access, tag, imports)
 
-let mkILGenericClass (nm, access, genparams, extends, impl, methods, fields, nestedTypes, props, events, attrs, init) =
+let mkILGenericClass (nm, access, genparams, extends, impls, methods, fields, nestedTypes, props, events, attrs, init) =
     let attributes =
         convertTypeAccessFlags access
         ||| TypeAttributes.AutoLayout
@@ -4254,8 +4266,7 @@ let mkILGenericClass (nm, access, genparams, extends, impl, methods, fields, nes
         name = nm,
         attributes = attributes,
         genericParams = genparams,
-        implements = impl,
-        implementsCustomAttrs = None,
+        implements = InterruptibleLazy.FromValue(impls),
         layout = ILTypeDefLayout.Auto,
         extends = Some extends,
         methods = methods,
@@ -4279,8 +4290,7 @@ let mkRawDataValueTypeDef (iltyp_ValueType: ILType) (nm, size, pack) =
              ||| TypeAttributes.ExplicitLayout
              ||| TypeAttributes.BeforeFieldInit
              ||| TypeAttributes.AnsiClass),
-        implements = [],
-        implementsCustomAttrs = None,
+        implements = emptyILInterfaceImpls,
         extends = Some iltyp_ValueType,
         layout = ILTypeDefLayout.Explicit { Size = Some size; Pack = Some pack },
         methods = emptyILMethods,
@@ -5586,7 +5596,7 @@ and refsOfILMethodImpl s m =
 and refsOfILTypeDef s (td: ILTypeDef) =
     refsOfILTypeDefs s td.NestedTypes
     refsOfILGenericParams s td.GenericParams
-    refsOfILTypes s td.Implements
+    refsOfILTypes s (td.Implements.Value |> List.map _.Type)
     Option.iter (refsOfILType s) td.Extends
     refsOfILMethodDefs s td.Methods
     refsOfILFieldDefs s (td.Fields.AsList())

src/Compiler/AbstractIL/il.fsi

@@ -327,6 +327,15 @@ type ILCallingSignature =
       ArgTypes: ILTypes
       ReturnType: ILType }
 
+type InterfaceImpl =
+    { Idx: int
+      Type: ILType
+      mutable CustomAttrsStored: ILAttributesStored }
+
+    member CustomAttrs: ILAttributes
+    static member Create: ilType: ILType * customAttrsStored: ILAttributesStored -> InterfaceImpl
+    static member Create: ilType: ILType -> InterfaceImpl
+
 /// Actual generic parameters are  always types.
 type ILGenericArgs = ILType list
 
@@ -1518,8 +1527,7 @@ type ILTypeDef =
         name: string *
         attributes: TypeAttributes *
         layout: ILTypeDefLayout *
-        implements: ILTypes *
-        implementsCustomAttrs: (ILAttributesStored * int) list option *
+        implements: InterruptibleLazy<InterfaceImpl list> *
         genericParams: ILGenericParameterDefs *
         extends: ILType option *
         methods: ILMethodDefs *
@@ -1539,8 +1547,7 @@ type ILTypeDef =
         name: string *
         attributes: TypeAttributes *
         layout: ILTypeDefLayout *
-        implements: ILTypes *
-        implementsCustomAttrs: (ILAttributesStored * int) list option *
+        implements: InterruptibleLazy<InterfaceImpl list> *
         genericParams: ILGenericParameterDefs *
         extends: ILType option *
         methods: ILMethodDefs *
@@ -1559,8 +1566,7 @@ type ILTypeDef =
     member GenericParams: ILGenericParameterDefs
     member Layout: ILTypeDefLayout
     member NestedTypes: ILTypeDefs
-    member Implements: ILTypes
-    member ImplementsCustomAttrs: (ILAttributesStored * int) list option
+    member Implements: InterruptibleLazy<InterfaceImpl list>
     member Extends: ILType option
     member Methods: ILMethodDefs
     member SecurityDecls: ILSecurityDecls
@@ -1609,7 +1615,7 @@ type ILTypeDef =
         ?name: string *
         ?attributes: TypeAttributes *
         ?layout: ILTypeDefLayout *
-        ?implements: ILTypes *
+        ?implements: InterruptibleLazy<InterfaceImpl list> *
         ?genericParams: ILGenericParameterDefs *
         ?extends: ILType option *
         ?methods: ILMethodDefs *
@@ -1620,8 +1626,7 @@ type ILTypeDef =
         ?properties: ILPropertyDefs *
         ?newAdditionalFlags: ILTypeDefAdditionalFlags *
         ?customAttrs: ILAttributesStored *
-        ?securityDecls: ILSecurityDecls *
-        ?implementsCustomAttrs: (ILAttributesStored * int) list option ->
+        ?securityDecls: ILSecurityDecls ->
             ILTypeDef
 
 /// Represents a prefix of information for ILTypeDef.
@@ -2161,7 +2166,7 @@ val internal mkILGenericClass:
     ILTypeDefAccess *
     ILGenericParameterDefs *
     ILType *
-    ILType list *
+    InterfaceImpl list *
     ILMethodDefs *
     ILFieldDefs *
     ILTypeDefs *
@@ -2245,6 +2250,8 @@ val internal mkCtorMethSpecForDelegate: ILGlobals -> ILType * bool -> ILMethodSp
 /// The toplevel "class" for a module or assembly.
 val internal mkILTypeForGlobalFunctions: ILScopeRef -> ILType
 
+val emptyILInterfaceImpls: InterruptibleLazy<InterfaceImpl list>
+
 /// Making tables of custom attributes, etc.
 val mkILCustomAttrs: ILAttribute list -> ILAttributes
 val mkILCustomAttrsFromArray: ILAttribute[] -> ILAttributes

src/Compiler/AbstractIL/ilmorph.fs

@@ -368,8 +368,13 @@ let rec tdef_ty2ty_ilmbody2ilmbody_mdefs2mdefs isInKnownSet enc fs (tdef: ILType
     let mdefsR = fMethodDefs (enc, tdef) tdef.Methods
     let fdefsR = fdefs_ty2ty fTyInCtxtR tdef.Fields
 
+    let implements =
+        tdef.Implements.Value
+        |> List.map (fun x -> { x with Type = fTyInCtxtR x.Type })
+        |> InterruptibleLazy.FromValue
+
     tdef.With(
-        implements = List.map fTyInCtxtR tdef.Implements,
+        implements = implements,
         genericParams = gparams_ty2ty fTyInCtxtR tdef.GenericParams,
         extends = Option.map fTyInCtxtR tdef.Extends,
         methods = mdefsR,

src/Compiler/AbstractIL/ilprint.fs

@@ -752,8 +752,9 @@ let goutput_superclass env os =
         output_string os "extends "
         (goutput_typ_with_shortened_class_syntax env) os typ
 
-let goutput_implements env os (imp: ILTypes) =
+let goutput_implements env os (imp: InterfaceImpl list) =
     if not (List.isEmpty imp) then
+        let imp = imp |> Seq.map _.Type
         output_string os "implements "
         output_seq ", " (goutput_typ_with_shortened_class_syntax env) os imp
 
@@ -836,7 +837,7 @@ let rec goutput_tdef enc env contents os (cd: ILTypeDef) =
         output_string os "\n\t"
         goutput_superclass env os cd.Extends
         output_string os "\n\t"
-        goutput_implements env os cd.Implements
+        goutput_implements env os cd.Implements.Value
         output_string os "\n{\n "
 
         if contents then

src/Compiler/AbstractIL/ilread.fs

@@ -2192,8 +2192,7 @@ and typeDefReader ctxtH : ILTypeDefStored =
         let fdefs = seekReadFields ctxt (numTypars, hasLayout) fieldsIdx endFieldsIdx
         let nested = seekReadNestedTypeDefs ctxt idx
 
-        let impls, intImplsAttrs =
-            seekReadInterfaceImpls ctxt mdv numTypars idx |> List.unzip
+        let impls = seekReadInterfaceImpls ctxt mdv numTypars idx
 
         let mimpls = seekReadMethodImpls ctxt numTypars idx
         let props = seekReadProperties ctxt numTypars idx
@@ -2206,7 +2205,6 @@ and typeDefReader ctxtH : ILTypeDefStored =
             layout = layout,
             nestedTypes = nested,
             implements = impls,
-            implementsCustomAttrs = Some intImplsAttrs,
             extends = super,
             methods = mdefs,
             securityDeclsStored = ctxt.securityDeclsReader_TypeDef,
@@ -2240,19 +2238,26 @@ and seekReadNestedTypeDefs (ctxt: ILMetadataReader) tidx =
         |])
 
 and seekReadInterfaceImpls (ctxt: ILMetadataReader) mdv numTypars tidx =
-    seekReadIndexedRows (
-        ctxt.getNumRows TableNames.InterfaceImpl,
-        id,
-        id,
-        (fun idx ->
-            let mutable addr = ctxt.rowAddr TableNames.InterfaceImpl idx
-            let _tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr
-            simpleIndexCompare tidx _tidx),
-        isSorted ctxt TableNames.InterfaceImpl,
-        (fun idx ->
-            let intfIdx = seekReadInterfaceIdx ctxt mdv idx
-            seekReadTypeDefOrRef ctxt numTypars AsObject [] intfIdx, (ctxt.customAttrsReader_InterfaceImpl, idx))
-    )
+    InterruptibleLazy(fun () ->
+        seekReadIndexedRows (
+            ctxt.getNumRows TableNames.InterfaceImpl,
+            id,
+            id,
+            (fun idx ->
+                let mutable addr = ctxt.rowAddr TableNames.InterfaceImpl idx
+                let _tidx = seekReadUntaggedIdx TableNames.TypeDef ctxt mdv &addr
+                simpleIndexCompare tidx _tidx),
+            isSorted ctxt TableNames.InterfaceImpl,
+            (fun idx ->
+                let intfIdx = seekReadInterfaceIdx ctxt mdv idx
+                let ilType = seekReadTypeDefOrRef ctxt numTypars AsObject [] intfIdx
+
+                {
+                    Idx = idx
+                    Type = ilType
+                    CustomAttrsStored = ctxt.customAttrsReader_InterfaceImpl
+                })
+        ))
 
 and seekReadGenericParams ctxt numTypars (a, b) : ILGenericParameterDefs =
     ctxt.seekReadGenericParams (GenericParamsIdx(numTypars, a, b))

src/Compiler/AbstractIL/ilreflect.fs

@@ -2178,7 +2178,8 @@ let rec buildTypeDefPass2 cenv nesting emEnv (tdef: ILTypeDef) =
     let typB = envGetTypB emEnv tref
     let emEnv = envPushTyvars emEnv (getGenericArgumentsOfType typB)
     // add interface impls
-    tdef.Implements
+    tdef.Implements.Value
+    |> List.map _.Type
     |> convTypes cenv emEnv
     |> List.iter (fun implT -> typB.AddInterfaceImplementationAndLog implT)
     // add methods, properties
@@ -2339,7 +2340,8 @@ let createTypeRef (visited: Dictionary<_, _>, created: Dictionary<_, _>) emEnv t
         if verbose2 then
             dprintf "buildTypeDefPass4: Creating Interface Chain of %s\n" tdef.Name
 
-        tdef.Implements |> List.iter (traverseType CollectTypes.All)
+        tdef.Implements.Value
+        |> List.iter (fun x -> traverseType CollectTypes.All x.Type)
 
         if verbose2 then
             dprintf "buildTypeDefPass4: Do value types in fields of %s\n" tdef.Name

src/Compiler/AbstractIL/ilwrite.fs

@@ -1323,7 +1323,7 @@ and GenTypeDefPass2 pidx enc cenv (tdef: ILTypeDef) =
         // Now generate or assign index numbers for tables referenced by the maps.
         // Don't yet generate contents of these tables - leave that to pass3, as
         // code may need to embed these entries.
-        cenv.implementsIdxs[tidx] <- tdef.Implements |> List.map (GenImplementsPass2 cenv env tidx)            
+        cenv.implementsIdxs[tidx] <- tdef.Implements.Value |> List.map (fun x -> GenImplementsPass2 cenv env tidx x.Type)            
 
         tdef.Fields.AsList() |> List.iter (GenFieldDefPass2 tdef cenv tidx)
         tdef.Methods |> Seq.iter (GenMethodDefPass2 tdef cenv tidx)
@@ -2875,12 +2875,9 @@ let rec GenTypeDefPass3 enc cenv (tdef: ILTypeDef) =
         let env = envForTypeDef tdef
         let tidx = GetIdxForTypeDef cenv (TdKey(enc, tdef.Name))
 
-        match tdef.ImplementsCustomAttrs with
-        | None -> ()
-        | Some attrList ->
-            attrList
-            |> List.zip cenv.implementsIdxs[tidx]
-            |> List.iter (fun (impIdx,(attrs,metadataIdx)) -> GenCustomAttrsPass3Or4 cenv (hca_InterfaceImpl,impIdx) (attrs.GetCustomAttrs metadataIdx))
+        tdef.Implements.Value
+        |> List.zip cenv.implementsIdxs[tidx]
+        |> List.iter (fun (impIdx, impl) -> GenCustomAttrsPass3Or4 cenv (hca_InterfaceImpl,impIdx) impl.CustomAttrs)
 
         tdef.Properties.AsList() |> List.iter (GenPropertyPass3 cenv env)
         tdef.Events.AsList() |> List.iter (GenEventPass3 cenv env)

src/Compiler/Checking/TypeHierarchy.fs

@@ -117,17 +117,16 @@ let GetImmediateInterfacesOfMetadataType g amap m skipUnref ty (tcref: TyconRef)
             // succeeded with more reported. There are pathological corner cases where this
             // doesn't apply: e.g. for mscorlib interfaces like IComparable, but we can always
             // assume those are present.
-            match tdef.ImplementsCustomAttrs with
-            | Some attrsList when g.langFeatureNullness && g.checkNullness ->
-                for (attrs,attrsIdx),intfTy in tdef.Implements |> List.zip attrsList do
-                    if skipUnref = SkipUnrefInterfaces.No || CanRescopeAndImportILType scoref amap m intfTy then
+            let checkNullness = g.langFeatureNullness && g.checkNullness
+            for {Idx = attrsIdx; Type = intfTy; CustomAttrsStored = attrs} in tdef.Implements.Value do
+                if skipUnref = SkipUnrefInterfaces.No || CanRescopeAndImportILType scoref amap m intfTy then
+                    if checkNullness then
                         let typeAttrs = AttributesFromIL(attrsIdx,attrs)
                         let nullness = {DirectAttributes = typeAttrs; Fallback = FromClass typeAttrs}
                         RescopeAndImportILType scoref amap m tinst nullness intfTy
-            | _ ->
-                for intfTy in tdef.Implements do
-                    if skipUnref = SkipUnrefInterfaces.No || CanRescopeAndImportILType scoref amap m intfTy then
+                    else
                         RescopeAndImportILTypeSkipNullness scoref amap m tinst intfTy
+
         | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata ->
             for intfTy in tcref.ImmediateInterfaceTypesOfFSharpTycon do
                instType (mkInstForAppTy g ty) intfTy ]

src/Compiler/CodeGen/EraseClosures.fs

@@ -572,8 +572,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo =
                         name = td.Name,
                         genericParams = td.GenericParams,
                         attributes = td.Attributes,
-                        implements = [],
-                        implementsCustomAttrs = None,
+                        implements = emptyILInterfaceImpls,
                         nestedTypes = emptyILTypeDefs,
                         layout = ILTypeDefLayout.Auto,
                         extends = Some cenv.mkILTyFuncTy,
@@ -707,8 +706,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo =
                         name = td.Name,
                         genericParams = td.GenericParams,
                         attributes = td.Attributes,
-                        implements = [],
-                        implementsCustomAttrs = None,
+                        implements = emptyILInterfaceImpls,
                         layout = ILTypeDefLayout.Auto,
                         nestedTypes = emptyILTypeDefs,
                         extends = Some nowEnvParentClass,