wip

src/Compiler/AbstractIL/il.fs

@@ -1908,6 +1908,24 @@ let inline conditionalAdd condition flagToAdd source =
 
 let NoMetadataIdx = -1
 
+type InterfaceImpl =
+    {Idx: int; Type: ILType; mutable CustomAttrsStored: ILAttributesStored}
+    with 
+    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) =
+        { Idx = NoMetadataIdx; Type = ilType; CustomAttrsStored = emptyILCustomAttrsStored }
+
+
 [<NoComparison; NoEquality; StructuredFormatDisplay("{DebugText}")>]
 type ILMethodDef
     (
@@ -2634,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,
@@ -2658,7 +2675,6 @@ type ILTypeDef
         attributes,
         layout,
         implements,
-        implementsCustomAttrs,
         genericParams,
         extends,
         methods,
@@ -2675,7 +2691,6 @@ type ILTypeDef
             attributes,
             layout,
             implements,
-            implementsCustomAttrs,
             genericParams,
             extends,
             methods,
@@ -2702,8 +2717,6 @@ type ILTypeDef
 
     member _.Implements = implements
 
-    member _.ImplementsCustomAttrs = implementsCustomAttrs
-
     member _.Extends = extends
 
     member _.Methods = methods
@@ -2732,7 +2745,7 @@ type ILTypeDef
             ?name,
             ?attributes,
             ?layout,
-            ?implements,
+            ?newImplements,
             ?genericParams,
             ?extends,
             ?methods,
@@ -2743,17 +2756,15 @@ type ILTypeDef
             ?properties,
             ?newAdditionalFlags,
             ?customAttrs,
-            ?securityDecls,
-            ?implementsCustomAttrs
+            ?securityDecls
         ) =
         ILTypeDef(
             name = defaultArg name x.Name,
             attributes = defaultArg attributes x.Attributes,
             layout = defaultArg layout x.Layout,
             genericParams = defaultArg genericParams x.GenericParams,
             nestedTypes = defaultArg nestedTypes x.NestedTypes,
-            implements = defaultArg implements x.Implements,
-            implementsCustomAttrs = defaultArg implementsCustomAttrs x.ImplementsCustomAttrs,
+            implements = defaultArg newImplements implements,
             extends = defaultArg extends x.Extends,
             methods = defaultArg methods x.Methods,
             securityDecls = defaultArg securityDecls x.SecurityDecls,
@@ -3331,6 +3342,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.
 // --------------------------------------------------------------------
@@ -4238,7 +4251,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
@@ -4252,8 +4265,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,
@@ -4277,8 +4289,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,
@@ -5584,7 +5595,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
 
@@ -1515,8 +1524,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 *
@@ -1536,8 +1544,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 *
@@ -1556,8 +1563,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
@@ -1606,7 +1612,7 @@ type ILTypeDef =
         ?name: string *
         ?attributes: TypeAttributes *
         ?layout: ILTypeDefLayout *
-        ?implements: ILTypes *
+        ?newImplements: InterruptibleLazy<InterfaceImpl list> *
         ?genericParams: ILGenericParameterDefs *
         ?extends: ILType option *
         ?methods: ILMethodDefs *
@@ -1617,8 +1623,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.
@@ -2158,7 +2163,7 @@ val internal mkILGenericClass:
     ILTypeDefAccess *
     ILGenericParameterDefs *
     ILType *
-    ILType list *
+    InterfaceImpl list *
     ILMethodDefs *
     ILFieldDefs *
     ILTypeDefs *
@@ -2242,6 +2247,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,
+        newImplements = 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

@@ -2198,8 +2198,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
@@ -2212,7 +2211,6 @@ and typeDefReader ctxtH : ILTypeDefStored =
             layout = layout,
             nestedTypes = nested,
             implements = impls,
-            implementsCustomAttrs = Some intImplsAttrs,
             extends = super,
             methods = mdefs,
             securityDeclsStored = ctxt.securityDeclsReader_TypeDef,
@@ -2246,14 +2244,22 @@ and seekReadNestedTypeDefs (ctxt: ILMetadataReader) tidx =
         |])
 
 and seekReadInterfaceImpls (ctxt: ILMetadataReader) mdv numTypars tidx =
-    seekReadIndexedRows (
-        ctxt.getNumRows TableNames.InterfaceImpl,
-        seekReadInterfaceImplRow ctxt mdv,
-        (fun x -> x.TypeIdx),
-        simpleIndexCompare tidx,
-        isSorted ctxt TableNames.InterfaceImpl,
-        (fun x -> (seekReadTypeDefOrRef ctxt numTypars AsObject [] x.IntfIdx), (ctxt.customAttrsReader_InterfaceImpl, x.IntImplIdx))
-    )
+    InterruptibleLazy(fun () ->
+        seekReadIndexedRows (
+            ctxt.getNumRows TableNames.InterfaceImpl,
+            seekReadInterfaceImplRow ctxt mdv,
+            (fun x -> x.TypeIdx),
+            simpleIndexCompare tidx,
+            isSorted ctxt TableNames.InterfaceImpl,
+            (fun x ->
+                let ilType = seekReadTypeDefOrRef ctxt numTypars AsObject [] x.IntfIdx
+
+                {
+                    Idx = x.IntImplIdx
+                    Type = ilType
+                    CustomAttrsStored = ctxt.customAttrsReader_InterfaceImpl
+                })
+        ))
 
 and seekReadGenericParams ctxt numTypars (a, b) : ILGenericParameterDefs =
     ctxt.seekReadGenericParams (GenericParamsIdx(numTypars, a, b))

src/Compiler/AbstractIL/ilreflect.fs

@@ -2175,7 +2175,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
@@ -2336,7 +2337,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)
@@ -2874,12 +2874,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 ]