wip

src/Compiler/AbstractIL/il.fs

@@ -2652,9 +2652,10 @@ type ILTypeDef
         name: string,
         attributes: TypeAttributes,
         layout: ILTypeDefLayout,
+        kind: ILTypeDefKind,
         implements: InterruptibleLazy<InterfaceImpl list>,
         genericParams: ILGenericParameterDefs,
-        extends: ILType option,
+        extends: InterruptibleLazy<ILType option>,
         methods: ILMethodDefs,
         nestedTypes: ILTypeDefs,
         fields: ILFieldDefs,
@@ -2674,6 +2675,7 @@ type ILTypeDef
     new(name,
         attributes,
         layout,
+        kind,
         implements,
         genericParams,
         extends,
@@ -2690,6 +2692,7 @@ type ILTypeDef
             name,
             attributes,
             layout,
+            kind,
             implements,
             genericParams,
             extends,
@@ -2705,6 +2708,42 @@ type ILTypeDef
             NoMetadataIdx
         )
 
+    new(name,
+        attributes,
+        layout,
+        implements,
+        genericParams,
+        extends,
+        methods,
+        nestedTypes,
+        fields,
+        methodImpls,
+        events,
+        properties,
+        additionalFlags,
+        securityDecls,
+        customAttrs) =
+        let kind = typeKindOfFlags name extends (int attributes)
+        ILTypeDef(
+            name,
+            attributes,
+            layout,
+            kind,
+            InterruptibleLazy.FromValue(implements),
+            genericParams,
+            InterruptibleLazy.FromValue(extends),
+            methods,
+            nestedTypes,
+            fields,
+            methodImpls,
+            events,
+            properties,
+            additionalFlags,
+            storeILSecurityDecls securityDecls,
+            customAttrs,
+            NoMetadataIdx
+        )
+
     member _.Name = name
 
     member _.Attributes = attributes
@@ -2764,8 +2803,8 @@ type ILTypeDef
             layout = defaultArg layout x.Layout,
             genericParams = defaultArg genericParams x.GenericParams,
             nestedTypes = defaultArg nestedTypes x.NestedTypes,
-            implements = defaultArg implements x.Implements,
-            extends = defaultArg extends x.Extends,
+            implements = defaultArg implements x.Implements.Value,
+            extends = defaultArg extends x.Extends.Value,
             methods = defaultArg methods x.Methods,
             securityDecls = defaultArg securityDecls x.SecurityDecls,
             fields = defaultArg fields x.Fields,
@@ -2787,19 +2826,19 @@ type ILTypeDef
     member x.SecurityDecls = x.SecurityDeclsStored.GetSecurityDecls x.MetadataIndex
 
     member x.IsClass =
-        (typeKindOfFlags x.Name x.Extends (int x.Attributes)) = ILTypeDefKind.Class
+        kind = ILTypeDefKind.Class
 
     member x.IsStruct =
-        (typeKindOfFlags x.Name x.Extends (int x.Attributes)) = ILTypeDefKind.ValueType
+        kind = ILTypeDefKind.ValueType
 
     member x.IsInterface =
-        (typeKindOfFlags x.Name x.Extends (int x.Attributes)) = ILTypeDefKind.Interface
+        kind = ILTypeDefKind.Interface
 
     member x.IsEnum =
-        (typeKindOfFlags x.Name x.Extends (int x.Attributes)) = ILTypeDefKind.Enum
+        kind = ILTypeDefKind.Enum
 
     member x.IsDelegate =
-        (typeKindOfFlags x.Name x.Extends (int x.Attributes)) = ILTypeDefKind.Delegate
+        kind = ILTypeDefKind.Delegate
 
     member x.Access = typeAccessOfFlags (int x.Attributes)
     member x.IsAbstract = x.Attributes &&& TypeAttributes.Abstract <> enum 0
@@ -2853,7 +2892,7 @@ type ILTypeDef
             extends =
                 match kind with
                 | ILTypeDefKind.Interface -> None
-                | _ -> x.Extends
+                | _ -> x.Extends.Value
         )
 
     member x.WithEncoding(encoding) =
@@ -3327,6 +3366,8 @@ let emptyILTypeDefs = mkILTypeDefsFromArray [||]
 
 let emptyILInterfaceImpls = InterruptibleLazy<InterfaceImpl list>.FromValue([])
 
+let emptyILExtends = InterruptibleLazy<ILType option>.FromValue(None)
+
 // --------------------------------------------------------------------
 // Operations on method tables.
 // --------------------------------------------------------------------
@@ -4248,7 +4289,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,
@@ -4272,7 +4313,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,
@@ -5579,7 +5620,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

@@ -1527,9 +1527,10 @@ type ILTypeDef =
         name: string *
         attributes: TypeAttributes *
         layout: ILTypeDefLayout *
+        kind: ILTypeDefKind *
         implements: InterruptibleLazy<InterfaceImpl list> *
         genericParams: ILGenericParameterDefs *
-        extends: ILType option *
+        extends: InterruptibleLazy<ILType option> *
         methods: ILMethodDefs *
         nestedTypes: ILTypeDefs *
         fields: ILFieldDefs *
@@ -1542,13 +1543,33 @@ 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 *
+        kind: ILTypeDefKind *
         implements: InterruptibleLazy<InterfaceImpl list> *
         genericParams: ILGenericParameterDefs *
+        extends: InterruptibleLazy<ILType option> *
+        methods: ILMethodDefs *
+        nestedTypes: ILTypeDefs *
+        fields: ILFieldDefs *
+        methodImpls: ILMethodImplDefs *
+        events: ILEventDefs *
+        properties: ILPropertyDefs *
+        additionalFlags: ILTypeDefAdditionalFlags *
+        securityDecls: ILSecurityDecls *
+        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 *
@@ -1567,7 +1588,7 @@ type ILTypeDef =
     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
@@ -1615,7 +1636,7 @@ type ILTypeDef =
         ?name: string *
         ?attributes: TypeAttributes *
         ?layout: ILTypeDefLayout *
-        ?implements: InterruptibleLazy<InterfaceImpl list> *
+        ?implements: InterfaceImpl list *
         ?genericParams: ILGenericParameterDefs *
         ?extends: ILType option *
         ?methods: ILMethodDefs *
@@ -2252,6 +2273,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

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

src/Compiler/AbstractIL/ilprint.fs

@@ -835,7 +835,7 @@ let rec goutput_tdef enc env contents os (cd: ILTypeDef) =
         output_sqstring os cd.Name
         goutput_gparams env os cd.GenericParams
         output_string os "\n\t"
-        goutput_superclass env os cd.Extends
+        goutput_superclass env os cd.Extends.Value
         output_string os "\n\t"
         goutput_implements env os cd.Implements.Value
         output_string os "\n{\n "

src/Compiler/AbstractIL/ilread.fs

@@ -2107,7 +2107,37 @@ and typeDefReader ctxtH : ILTypeDefStored =
         let struct (endFieldsIdx, endMethodsIdx) = seekReadTypeDefRowExtents ctxt info idx
         let typars = seekReadGenericParams ctxt 0 (tomd_TypeDef, idx)
         let numTypars = typars.Length
-        let super = seekReadOptionalTypeDefOrRef ctxt numTypars AsObject extendsIdx
+
+        let kind =
+            let extendsTag = extendsIdx.tag
+            let extendsIdx = extendsIdx.index
+
+            if flags &&& 0x00000020 <> 0x0 then
+                ILTypeDefKind.Interface
+            else if extendsIdx = 0 && extendsTag = tdor_TypeDef then
+                ILTypeDefKind.Class
+            else
+                let extendsName =
+                    if extendsTag = tdor_TypeDef then
+                        let mutable addr = ctxt.rowAddr TableNames.TypeDef extendsIdx
+                        let _ = seekReadInt32Adv mdv &addr
+                        let nameIdx = seekReadStringIdx ctxt mdv &addr
+                        let namespaceIdx = seekReadStringIdx ctxt mdv &addr
+                        readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx)
+                    elif extendsTag = tdor_TypeRef then
+                        let _, nameIdx, namespaceIdx = seekReadTypeRefRow ctxt mdv extendsIdx
+                        readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx)
+                    else
+                        ""
+
+                match extendsName with
+                | "System.Enum" -> ILTypeDefKind.Enum
+                | "System.Delegate" when nm <> "System.MulticastDelegate" -> ILTypeDefKind.Delegate
+                | "System.MulticastDelegate" -> ILTypeDefKind.Delegate
+                | "System.ValueType" when nm <> "System.Enum" -> ILTypeDefKind.ValueType
+                | _ -> ILTypeDefKind.Class
+
+        let super = seekReadSuperType ctxt numTypars AsObject extendsIdx
         let layout = typeLayoutOfFlags ctxt mdv flags idx
 
         let hasLayout =
@@ -2195,6 +2225,7 @@ and typeDefReader ctxtH : ILTypeDefStored =
             genericParams = typars,
             attributes = enum<TypeAttributes> (flags),
             layout = layout,
+            kind = kind,
             nestedTypes = nested,
             implements = impls,
             extends = super,
@@ -2456,6 +2487,12 @@ and seekReadOptionalTypeDefOrRef (ctxt: ILMetadataReader) numTypars boxity idx =
     else
         Some(seekReadTypeDefOrRef ctxt numTypars boxity List.empty idx)
 
+and seekReadSuperType (ctxt: ILMetadataReader) numTypars boxity idx =
+    if idx = TaggedIndex(tdor_TypeDef, 0) then
+        emptyILExtends
+    else
+        InterruptibleLazy(fun () -> seekReadOptionalTypeDefOrRef ctxt numTypars boxity idx)
+
 and seekReadField ctxt mdv (numTypars, hasLayout) (idx: int) =
     let flags, nameIdx, typeIdx = seekReadFieldRow ctxt mdv idx
     let nm = readStringHeap ctxt nameIdx

src/Compiler/AbstractIL/ilreflect.fs

@@ -2160,7 +2160,7 @@ let rec buildTypeDefPass1b cenv nesting emEnv (tdef: ILTypeDef) =
     let genArgs = getGenericArgumentsOfType typB
     let emEnv = envPushTyvars emEnv genArgs
     // Parent may reference types being defined, so has to come after it's Pass1 creation
-    tdef.Extends
+    tdef.Extends.Value
     |> Option.iter (fun ty -> typB.SetParentAndLog(convType cenv emEnv ty))
     // build constraints on ILGenericParameterDefs. Constraints may reference types being defined,
     // so have to come after all types are created
@@ -2334,7 +2334,7 @@ let createTypeRef (visited: Dictionary<_, _>, created: Dictionary<_, _>) emEnv t
         if verbose2 then
             dprintf "buildTypeDefPass4: Creating Super Class Chain of %s\n" tdef.Name
 
-        tdef.Extends |> Option.iter (traverseType CollectTypes.All)
+        tdef.Extends.Value |> Option.iter (traverseType CollectTypes.All)
 
         // We absolutely need the exact interface types...
         if verbose2 then

src/Compiler/AbstractIL/ilwrite.fs

@@ -1223,7 +1223,7 @@ let rec GetTypeDefAsRow cenv env _enc (tdef: ILTypeDef) =
       else
         int tdef.Attributes
 
-    let tdorTag, tdorRow = GetTypeOptionAsTypeDefOrRef cenv env tdef.Extends
+    let tdorTag, tdorRow = GetTypeOptionAsTypeDefOrRef cenv env tdef.Extends.Value
     UnsharedRow
        [| ULong flags
           nelem

src/Compiler/Checking/TypeHierarchy.fs

@@ -54,7 +54,7 @@ let GetSuperTypeOfType g amap m ty =
 #endif
         | ILTypeMetadata (TILObjectReprData(scoref, _, tdef)) ->
             let tinst = argsOfAppTy g ty
-            match tdef.Extends with
+            match tdef.Extends.Value with
             | None -> None
             | Some ilTy ->   // 'inherit' can refer to a type which has nullable type arguments (e.g. List<string?>)
                 let typeAttrs = AttributesFromIL(tdef.MetadataIndex,tdef.CustomAttrsStored)

src/Compiler/CodeGen/EraseClosures.fs

@@ -572,7 +572,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo =
                         name = td.Name,
                         genericParams = td.GenericParams,
                         attributes = td.Attributes,
-                        implements = emptyILInterfaceImpls,
+                        implements = [],
                         nestedTypes = emptyILTypeDefs,
                         layout = ILTypeDefLayout.Auto,
                         extends = Some cenv.mkILTyFuncTy,
@@ -706,7 +706,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo =
                         name = td.Name,
                         genericParams = td.GenericParams,
                         attributes = td.Attributes,
-                        implements = emptyILInterfaceImpls,
+                        implements = [],
                         layout = ILTypeDefLayout.Auto,
                         nestedTypes = emptyILTypeDefs,
                         extends = Some nowEnvParentClass,
@@ -733,7 +733,7 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo =
 
             // No code is being declared: just bake a (mutable) environment
             let cloCodeR =
-                match td.Extends with
+                match td.Extends.Value with
                 | None -> (mkILNonGenericEmptyCtor (cenv.ilg.typ_Object, None, cloImports)).MethodBody
                 | Some _ -> convILMethodBody (Some nowCloSpec, None) clo.cloCode.Value
 
@@ -766,11 +766,11 @@ let rec convIlxClosureDef cenv encl (td: ILTypeDef) clo =
 
             let cloTypeDef =
                 td.With(
-                    implements = td.Implements,
+                    implements = td.Implements.Value,
                     extends =
-                        (match td.Extends with
+                        (match td.Extends.Value with
                          | None -> Some cenv.ilg.typ_Object
-                         | Some x -> Some(x)),
+                         | _ -> td.Extends.Value),
                     name = td.Name,
                     genericParams = td.GenericParams,
                     methods = mkILMethods (ctorMethodDef :: nowMethods),