提交 5ef60c91 编写于 作者: D Don Syme

Fix ILTypeDefs and ILMethodDefs representations

上级 2d413fb9
......@@ -910,11 +910,11 @@ type ILAttribute =
{ Method: ILMethodSpec;
Data: byte[] }
[<NoEquality; NoComparison>]
type ILAttributes =
| CustomAttrsLazy of Lazy<ILAttribute list>
| CustomAttrs of ILAttribute list
member x.AsList = match x with | CustomAttrsLazy l -> l.Force() | CustomAttrs l -> l
[<NoEquality; NoComparison; Sealed>]
type ILAttributes(f: unit -> ILAttribute[]) =
let mutable array = InlineDelayInit<_>(f)
member x.AsArray = array.Value
member x.AsList = x.AsArray |> Array.toList
type ILCodeLabel = int
......@@ -1523,25 +1523,31 @@ type ILMethodDef =
/// Index table by name and arity.
type MethodDefMap = Map<string, ILMethodDef list>
[<NoEquality; NoComparison>]
type ILMethodDefs =
| Methods of Lazy<ILMethodDef list * MethodDefMap>
[<Sealed>]
type ILMethodDefs(f : (unit -> ILMethodDef[])) =
let mutable array = InlineDelayInit<_>(f)
let mutable dict = InlineDelayInit<_>(fun () ->
let arr = array.Value
let t = Dictionary<_,_>()
for y in arr do
let key = y.Name
if t.ContainsKey key then
t.[key] <- y :: t.[key]
else
t.[key] <- [ y ]
t)
interface IEnumerable with
member x.GetEnumerator() = ((x :> IEnumerable<ILMethodDef>).GetEnumerator() :> IEnumerator)
interface IEnumerable<ILMethodDef> with
member x.GetEnumerator() =
let (Methods(lms)) = x
let ms,_ = lms.Force()
(ms :> IEnumerable<ILMethodDef>).GetEnumerator()
member x.AsList = Seq.toList x
member x.FindByName nm =
let (Methods lpmap) = x
let t = snd (Lazy.force lpmap)
Map.tryFindMulti nm t
interface IEnumerable<ILMethodDef> with
member x.GetEnumerator() = (array.Value :> IEnumerable<ILMethodDef>).GetEnumerator()
member x.FindByNameAndArity (nm,arity) =
x.FindByName nm |> List.filter (fun x -> x.Parameters.Length = arity)
member x.AsArray = array.Value
member x.AsList = x.AsArray |> Array.toList
member x.FindByName nm = dict.Value.[nm]
member x.FindByNameAndArity (nm,arity) = x.FindByName nm |> List.filter (fun x -> x.Parameters.Length = arity)
[<NoComparison; NoEquality>]
......@@ -1694,28 +1700,32 @@ type ILTypeDef =
| _ -> false
and ILTypeDefs =
| TypeDefTable of Lazy<(string list * string * ILAttributes * Lazy<ILTypeDef>) array> * Lazy<ILTypeDefsMap>
and [<Sealed>] ILTypeDefs(f : unit -> (string list * string * ILAttributes * Lazy<ILTypeDef>)[]) =
let mutable array = InlineDelayInit<_>(f)
let mutable dict = InlineDelayInit<_>(fun () ->
let arr = array.Value
let t = Dictionary<_,_>(HashIdentity.Structural)
for (nsp, nm, _attr, ltd) in arr do
let key = nsp, nm
t.[key] <- ltd
t)
member x.AsArray = [| for (_,_,_,ltd) in array.Value -> ltd.Force() |]
member x.AsList = x.AsArray |> Array.toList
interface IEnumerable with
member x.GetEnumerator() = ((x :> IEnumerable<ILTypeDef>).GetEnumerator() :> IEnumerator)
interface IEnumerable<ILTypeDef> with
member x.GetEnumerator() =
let (TypeDefTable (larr,_tab)) = x
let tds = seq { for (_,_,_,td) in larr.Force() -> td.Force() }
tds.GetEnumerator()
member x.AsList = Seq.toList x
(seq { for (_,_,_,ltd) in array.Value -> ltd.Force() }).GetEnumerator()
member x.AsListOfLazyTypeDefs = let (TypeDefTable (larr,_tab)) = x in larr.Force() |> Array.toList
member x.AsArrayOfLazyTypeDefs = array.Value
member x.FindByName nm =
let (TypeDefTable (_,m)) = x
let ns,n = splitILTypeName nm
m.Force().[ns].[n].Force()
/// keyed first on namespace then on type name. The namespace is often a unique key for a given type map.
and ILTypeDefsMap =
Map<string list,Dictionary<string,Lazy<ILTypeDef>>>
dict.Value.[(ns,n)].Force()
type ILNestedExportedType =
{ Name: string;
......@@ -2018,10 +2028,11 @@ let mkILFieldSpec (tref,ty) = { FieldRef= tref; EnclosingType=ty }
let mkILFieldSpecInTy (typ:ILType,nm,fty) =
mkILFieldSpec (mkILFieldRef (typ.TypeRef,nm,fty), typ)
let emptyILCustomAttrs = CustomAttrs []
let emptyILCustomAttrs = ILAttributes (fun () -> [| |])
let mkILCustomAttrs l = match l with [] -> emptyILCustomAttrs | _ -> CustomAttrs l
let mkILComputedCustomAttrs l = CustomAttrsLazy (Lazy.Create l)
let mkILCustomAttrsFromArray (l: ILAttribute[]) = if l.Length = 0 then emptyILCustomAttrs else ILAttributes (fun () -> l)
let mkILCustomAttrs l = l |> List.toArray |> mkILCustomAttrsFromArray
let mkILComputedCustomAttrs f = ILAttributes f
let andTailness x y =
match x with Tailcall when y -> Tailcall | _ -> Normalcall
......@@ -2331,14 +2342,12 @@ let addILTypeDefToTable (ns,n,_cas,ltd) tab =
let addLazyTypeDefToTable ltd larr = lazyMap (fun arr -> Array.ofList (getName ltd :: Array.toList arr)) larr
let buildTable larr = lazyMap (fun arr -> Array.foldBack addILTypeDefToTable arr Map.empty) larr
let buildTypes larr = TypeDefTable (larr, buildTable larr)
(* this is not performance critical *)
let addILTypeDef td (TypeDefTable (larr,_ltab)) = buildTypes (addLazyTypeDefToTable (notlazy td) larr)
let mkILTypeDefs l = buildTypes (List.map (notlazy >> getName) l |> Array.ofList |> notlazy )
let mkILTypeDefsLazy llist = buildTypes (lazyMap Array.ofList llist)
let emptyILTypeDefs = mkILTypeDefs []
let addILTypeDef td (tdefs: ILTypeDefs) = ILTypeDefs (fun () -> [| yield getName (notlazy td); yield! tdefs.AsArrayOfLazyTypeDefs |])
let mkILTypeDefsFromArray l = ILTypeDefs (fun () -> Array.map (notlazy >> getName) l)
let mkILTypeDefs l = mkILTypeDefsFromArray (Array.ofList l)
let mkILTypeDefsComputed f = ILTypeDefs f
let emptyILTypeDefs = mkILTypeDefsFromArray [| |]
// --------------------------------------------------------------------
// Operations on method tables.
......@@ -2351,17 +2360,13 @@ let addILMethodToTable (y: ILMethodDef) tab =
let prev = Map.tryFindMulti key tab
Map.add key (y::prev) tab
let addILMethod_to_pmap y (mds,tab) = y::mds,addILMethodToTable y tab
let addILMethod y (Methods lpmap) = Methods (lazyMap (addILMethod_to_pmap y) lpmap)
let mkILMethods l = Methods (notlazy (List.foldBack addILMethod_to_pmap l ([],Map.empty)))
let mkILMethodsLazy l = Methods (lazy (List.foldBack addILMethod_to_pmap (Lazy.force l) ([],Map.empty)))
let emptyILMethods = mkILMethods []
let mkILMethodsFromArray xs = ILMethodDefs (fun () -> xs)
let mkILMethods xs = xs |> Array.ofList |> mkILMethodsFromArray
let mkILMethodsComputed f = ILMethodDefs f
let emptyILMethods = mkILMethodsFromArray [| |]
let filterILMethodDefs f (Methods lpmap) =
Methods (lazyMap (fun (fs,_) ->
let l = List.filter f fs
(l, List.foldBack addILMethodToTable l Map.empty)) lpmap)
let filterILMethodDefs f (mdefs: ILMethodDefs) =
ILMethodDefs (fun () -> mdefs.AsArray |> Array.filter f)
// --------------------------------------------------------------------
......@@ -3253,16 +3258,17 @@ let prependInstrsToCode c1 c2 =
let prependInstrsToMethod new_code md =
mdef_code2code (prependInstrsToCode new_code) md
(* Creates cctor if needed *)
// Creates cctor if needed
let cdef_cctorCode2CodeOrCreate tag f cd =
let mdefs = cd.Methods
let md,mdefs =
let cctor =
match mdefs.FindByName ".cctor" with
| [mdef] -> mdef,filterILMethodDefs (fun md -> md.Name <> ".cctor") mdefs
| [] -> mkILClassCtor (mkMethodBody (false,emptyILLocals,1,nonBranchingInstrsToCode [ ],tag)), mdefs
| [ mdef ] -> mdef
| [ ] -> mkILClassCtor (mkMethodBody (false,emptyILLocals,1,nonBranchingInstrsToCode [ ],tag))
| _ -> failwith "bad method table: more than one .cctor found"
let md' = f md
{cd with Methods = addILMethod md' mdefs}
let methods = ILMethodDefs (fun () -> [| yield f cctor; for md in mdefs do if md.Name <> ".cctor" then yield md |])
{cd with Methods = methods}
let code_of_mdef (md:ILMethodDef) =
......@@ -3452,10 +3458,10 @@ let mkILSimpleClass ilg (nm, access, methods, fields, nestedTypes, props, events
let mkILTypeDefForGlobalFunctions ilg (methods,fields) = mkILSimpleClass ilg (typeNameForGlobalFunctions, ILTypeDefAccess.Public, methods, fields, emptyILTypeDefs, emptyILProperties, emptyILEvents, emptyILCustomAttrs,ILTypeInit.BeforeField)
let destTypeDefsWithGlobalFunctionsFirst ilg (tdefs: ILTypeDefs) =
let l = tdefs.AsList
let top,nontop = l |> List.partition (fun td -> td.Name = typeNameForGlobalFunctions)
let top2 = if isNil top then [mkILTypeDefForGlobalFunctions ilg (emptyILMethods, emptyILFields)] else top
top2@nontop
let l = tdefs.AsArray
let top,nontop = l |> Array.partition (fun td -> td.Name = typeNameForGlobalFunctions)
let top2 = if top.Length = 0 then [| mkILTypeDefForGlobalFunctions ilg (emptyILMethods, emptyILFields) |] else top
Array.append top2 nontop
let mkILSimpleModule assname modname dll subsystemVersion useHighEntropyVA tdefs hashalg locale flags exportedTypes metadataVersion =
{ Manifest=
......@@ -5095,11 +5101,9 @@ let resolveILMethodRef td (mref:ILMethodRef) =
(md.Parameters,mref.ArgTypes) ||> ILList.lengthsEqAndForall2 (fun p1 p2 -> p1.Type = p2) &&
// REVIEW: this uses equality on ILType. For CMOD_OPTIONAL this is not going to be correct
md.Return.Type = mref.ReturnType) with
| [] ->
failwith ("no method named "+nm+" with appropriate argument types found in type "+td.Name);
| [mdef] -> mdef
| _ ->
failwith ("multiple methods named "+nm+" appear with identical argument types in type "+td.Name)
| [ ] -> failwith ("no method named "+nm+" with appropriate argument types found in type "+td.Name);
| [ mdef ] -> mdef
| _ -> failwith ("multiple methods named "+nm+" appear with identical argument types in type "+td.Name)
let mkRefToILModule m =
ILModuleRef.Create(m.Name, true, None)
......@@ -5120,17 +5124,15 @@ let ungenericizeTypeName n =
String.sub n 0 pos
else n
type ILEventRef =
type ILEventRef =
{ erA: ILTypeRef; erB: string }
static member Create(a,b) = {erA=a;erB=b}
member x.EnclosingTypeRef = x.erA
member x.Name = x.erB
type ILPropertyRef =
type ILPropertyRef =
{ prA: ILTypeRef; prB: string }
static member Create (a,b) = {prA=a;prB=b}
member x.EnclosingTypeRef = x.prA
member x.Name = x.prB
member x.Name = x.prB
\ No newline at end of file
......@@ -1268,6 +1268,7 @@ type ILMethodDef =
[<NoEquality; NoComparison; Sealed>]
type ILMethodDefs =
interface IEnumerable<ILMethodDef>
member AsArray : ILMethodDef[]
member AsList : ILMethodDef list
member FindByName : string -> ILMethodDef list
......@@ -1416,10 +1417,11 @@ type ILTypeDefKind =
[<Sealed>]
type ILTypeDefs =
interface IEnumerable<ILTypeDef>
member AsArray : ILTypeDef[]
member AsList : ILTypeDef list
/// Get some information about the type defs, but do not force the read of the type defs themselves
member AsListOfLazyTypeDefs : (string list * string * ILAttributes * Lazy<ILTypeDef>) list
member AsArrayOfLazyTypeDefs : (string list * string * ILAttributes * Lazy<ILTypeDef>)[]
/// Calls to [FindByName] will result in any laziness in the overall
/// set of ILTypeDefs being read in in addition
......@@ -1792,7 +1794,7 @@ val EcmaILGlobals : ILGlobals
/// When writing a binary the fake "toplevel" type definition (called <Module>)
/// must come first. This function puts it first, and creates it in the returned list as an empty typedef if it
/// doesn't already exist.
val destTypeDefsWithGlobalFunctionsFirst: ILGlobals -> ILTypeDefs -> ILTypeDef list
val destTypeDefsWithGlobalFunctionsFirst: ILGlobals -> ILTypeDefs -> ILTypeDef[]
/// Note: not all custom attribute data can be decoded without binding types. In particular
/// enums must be bound in order to discover the size of the underlying integer.
......@@ -2023,7 +2025,8 @@ val mkILTypeForGlobalFunctions: ILScopeRef -> ILType
/// Making tables of custom attributes, etc.
val mkILCustomAttrs: ILAttribute list -> ILAttributes
val mkILComputedCustomAttrs: (unit -> ILAttribute list) -> ILAttributes
val mkILCustomAttrsFromArray: ILAttribute[] -> ILAttributes
val mkILComputedCustomAttrs: (unit -> ILAttribute[]) -> ILAttributes
val emptyILCustomAttrs: ILAttributes
val mkILSecurityDecls: ILPermission list -> ILPermissions
......@@ -2042,8 +2045,8 @@ val mkILPropertiesLazy: Lazy<ILPropertyDef list> -> ILPropertyDefs
val emptyILProperties: ILPropertyDefs
val mkILMethods: ILMethodDef list -> ILMethodDefs
val mkILMethodsLazy: Lazy<ILMethodDef list> -> ILMethodDefs
val addILMethod: ILMethodDef -> ILMethodDefs -> ILMethodDefs
val mkILMethodsFromArray: ILMethodDef[] -> ILMethodDefs
val mkILMethodsComputed: (unit -> ILMethodDef[]) -> ILMethodDefs
val emptyILMethods: ILMethodDefs
val mkILFields: ILFieldDef list -> ILFieldDefs
......@@ -2054,7 +2057,8 @@ val mkILMethodImpls: ILMethodImplDef list -> ILMethodImplDefs
val mkILMethodImplsLazy: Lazy<ILMethodImplDef list> -> ILMethodImplDefs
val emptyILMethodImpls: ILMethodImplDefs
val mkILTypeDefs: ILTypeDef list -> ILTypeDefs
val mkILTypeDefs: ILTypeDef list -> ILTypeDefs
val mkILTypeDefsFromArray: ILTypeDef[] -> ILTypeDefs
val emptyILTypeDefs: ILTypeDefs
/// Create table of types which is loaded/computed on-demand, and whose individual
......@@ -2065,7 +2069,7 @@ val emptyILTypeDefs: ILTypeDefs
///
/// Note that individual type definitions may contain further delays
/// in their method, field and other tables.
val mkILTypeDefsLazy: Lazy<(string list * string * ILAttributes * Lazy<ILTypeDef>) list> -> ILTypeDefs
val mkILTypeDefsComputed: (unit -> (string list * string * ILAttributes * Lazy<ILTypeDef>)[]) -> ILTypeDefs
val addILTypeDef: ILTypeDef -> ILTypeDefs -> ILTypeDefs
val mkILNestedExportedTypes: ILNestedExportedType list -> ILNestedExportedTypes
......@@ -2251,25 +2255,6 @@ val getTyOfILEnumInfo: ILEnumInfo -> ILType
val computeILEnumInfo: string * ILFieldDefs -> ILEnumInfo
// --------------------------------------------------------------------
// For completeness. These do not occur in metadata but tools that
// care about the existence of properties and events in the metadata
// can benefit from them.
// --------------------------------------------------------------------
[<Sealed>]
type ILEventRef =
static member Create : ILTypeRef * string -> ILEventRef
member EnclosingTypeRef: ILTypeRef
member Name: string
[<Sealed>]
type ILPropertyRef =
static member Create : ILTypeRef * string -> ILPropertyRef
member EnclosingTypeRef: ILTypeRef
member Name: string
interface System.IComparable
val runningOnMono: bool
type ILReferences =
......@@ -2286,3 +2271,22 @@ val emptyILRefs: ILReferences
type ILTypeDefKindExtension<'Extension> = TypeDefKindExtension
val RegisterTypeDefKindExtension: ILTypeDefKindExtension<'Extension> -> ('Extension -> IlxExtensionTypeKind) * (IlxExtensionTypeKind -> bool) * (IlxExtensionTypeKind -> 'Extension)
// --------------------------------------------------------------------
// For completeness. These do not occur in metadata but tools that
// care about the existence of properties and events in the metadata
// can benefit from them.
// --------------------------------------------------------------------
[<Sealed>]
type ILEventRef =
static member Create : ILTypeRef * string -> ILEventRef
member EnclosingTypeRef: ILTypeRef
member Name: string
[<Sealed>]
type ILPropertyRef =
static member Create : ILTypeRef * string -> ILPropertyRef
member EnclosingTypeRef: ILTypeRef
member Name: string
interface System.IComparable
\ No newline at end of file
......@@ -29,6 +29,24 @@ let (===) x y = LanguagePrimitives.PhysicalEquality x y
// Library: projections
//------------------------------------------------------------------------
[<Struct>]
/// An efficient lazy for inline storage in a class type. Results in fewer thunks.
type InlineDelayInit<'T when 'T : not struct> =
new (f: unit -> 'T) = {store = Unchecked.defaultof<'T>; func = System.Func<_>(f) }
val mutable store : 'T
val mutable func : System.Func<'T>
member x.Value =
match x.func with
| null -> x.store
| _ ->
let res = System.Threading.LazyInitializer.EnsureInitialized(&x.store, x.func)
x.func <- Unchecked.defaultof<_>
res
//-------------------------------------------------------------------------
// Library: projections
//------------------------------------------------------------------------
let foldOn p f z x = f z (p x)
let notFound() = raise (KeyNotFoundException())
......
......@@ -368,10 +368,10 @@ let morphILMethodDefs f (m:ILMethodDefs) = mkILMethods (List.map f m.AsList)
let fdefs_fdef2fdef f (m:ILFieldDefs) = mkILFields (List.map f m.AsList)
(* use this when the conversion produces just one type... *)
let morphILTypeDefs f (m: ILTypeDefs) = mkILTypeDefs (List.map f m.AsList)
let morphILTypeDefs f (m: ILTypeDefs) = mkILTypeDefsFromArray (Array.map f m.AsArray)
let morphExpandILTypeDefs f (m:ILTypeDefs) =
mkILTypeDefs (List.foldBack (fun x y -> f x @ y) m.AsList [])
mkILTypeDefs (List.collect f m.AsList)
let morphILTypeDefsInILModule typesf m =
{m with TypeDefs=typesf m.TypeDefs}
......
......@@ -1545,7 +1545,7 @@ let rec seekReadModule ctxt (subsys,subsysversion,useHighEntropyVA, ilOnly,only3
CustomAttrs = seekReadCustomAttrs ctxt (TaggedIndex(hca_Module,idx));
Name = ilModuleName;
NativeResources=nativeResources;
TypeDefs = mkILTypeDefsLazy (lazy (seekReadTopTypeDefs ctxt ()));
TypeDefs = mkILTypeDefsComputed (fun () -> seekReadTopTypeDefs ctxt ());
SubSystemFlags = int32 subsys;
IsILOnly = ilOnly;
SubsystemVersion = subsysversion
......@@ -1763,19 +1763,18 @@ and seekReadTypeDef ctxt toponly (idx:int) =
Some (ns,n,cas,rest)
and seekReadTopTypeDefs ctxt () =
[ for i = 1 to ctxt.getNumRows TableNames.TypeDef do
[| for i = 1 to ctxt.getNumRows TableNames.TypeDef do
match seekReadTypeDef ctxt true i with
| None -> ()
| Some td -> yield td ]
| Some td -> yield td |]
and seekReadNestedTypeDefs ctxt tidx =
mkILTypeDefsLazy
(lazy
mkILTypeDefsComputed (fun () ->
let nestedIdxs = seekReadIndexedRows (ctxt.getNumRows TableNames.Nested,seekReadNestedRow ctxt,snd,simpleIndexCompare tidx,false,fst)
[ for i in nestedIdxs do
[| for i in nestedIdxs do
match seekReadTypeDef ctxt false i with
| None -> ()
| Some td -> yield td ])
| Some td -> yield td |])
and seekReadInterfaceImpls ctxt numtypars tidx =
seekReadIndexedRows (ctxt.getNumRows TableNames.InterfaceImpl,
......@@ -1971,10 +1970,9 @@ and seekReadFields ctxt (numtypars, hasLayout) fidx1 fidx2 =
yield seekReadField ctxt (numtypars, hasLayout) i ])
and seekReadMethods ctxt numtypars midx1 midx2 =
mkILMethodsLazy
(lazy
[ for i = midx1 to midx2 - 1 do
yield seekReadMethod ctxt numtypars i ])
mkILMethodsComputed (fun () ->
[| for i = midx1 to midx2 - 1 do
yield seekReadMethod ctxt numtypars i |])
and sigptrGetTypeDefOrRefOrSpecIdx bytes sigptr =
let n, sigptr = sigptrGetZInt32 bytes sigptr
......@@ -2516,7 +2514,8 @@ and seekReadCustomAttrs ctxt idx =
seekReadCustomAttributeRow ctxt,(fun (a,_,_) -> a),
hcaCompare idx,
isSorted ctxt TableNames.CustomAttribute,
(fun (_,b,c) -> seekReadCustomAttr ctxt (b,c))))
(fun (_,b,c) -> seekReadCustomAttr ctxt (b,c)))
|> List.toArray)
and seekReadCustomAttr ctxt (TaggedIndex(cat,idx),b) =
ctxt.seekReadCustomAttr (CustomAttrIdx (cat,idx,b))
......
......@@ -1828,7 +1828,7 @@ let createTypeRef (visited : Dictionary<_,_>, created : Dictionary<_,_>) emEnv t
if verbose2 then dprintf "buildTypeDefPass4: Doing type typar constraints of %s\n" tdef.Name;
tdef.GenericParams |> List.iter (fun gp -> gp.Constraints |> ILList.iter (traverseType false 2));
if verbose2 then dprintf "buildTypeDefPass4: Doing method constraints of %s\n" tdef.Name;
tdef.Methods.AsList |> Seq.iter (fun md -> md.GenericParams |> List.iter (fun gp -> gp.Constraints |> ILList.iter (traverseType false 2)));
tdef.Methods.AsList |> List.iter (fun md -> md.GenericParams |> List.iter (fun gp -> gp.Constraints |> ILList.iter (traverseType false 2)));
// We absolutely need the parent type...
if priority >= 1 then
......@@ -1843,7 +1843,7 @@ let createTypeRef (visited : Dictionary<_,_>, created : Dictionary<_,_>) emEnv t
// We have to define all struct types in all methods before a class is defined. This only has any effect when there is a struct type
// being defined simultaneously with this type.
if priority >= 1 then
if verbose2 then dprintf "buildTypeDefPass4: Doing value types in method signatures of %s, #mdefs = %d\n" tdef.Name tdef.Methods.AsList.Length;
if verbose2 then dprintf "buildTypeDefPass4: Doing value types in method signatures of %s\n" tdef.Name
tdef.Methods |> Seq.iter (fun md -> md.Parameters |> ILList.iter (fun p -> p.Type |> (traverseType true 1))
md.Return.Type |> traverseType true 1);
......@@ -1918,21 +1918,21 @@ let buildModuleTypePass4 visited emEnv tdef = buildTypeDefPass4 visited [] emE
//----------------------------------------------------------------------------
let buildModuleFragment cenv emEnv (asmB : AssemblyBuilder) (modB : ModuleBuilder) (m: ILModuleDef) =
let tdefs = m.TypeDefs.AsList
let tdefs = m.TypeDefs.AsArray
let emEnv = List.fold (buildModuleTypePass1 cenv modB) emEnv tdefs
tdefs |> List.iter (buildModuleTypePass1b cenv emEnv)
let emEnv = List.fold (buildModuleTypePass2 cenv) emEnv tdefs
let emEnv = (emEnv, tdefs) ||> Array.fold (buildModuleTypePass1 cenv modB)
tdefs |> Array.iter (buildModuleTypePass1b cenv emEnv)
let emEnv = (emEnv, tdefs) ||> Array.fold (buildModuleTypePass2 cenv)
for delayedFieldInit in emEnv.delayedFieldInits do
delayedFieldInit()
let emEnv = { emEnv with delayedFieldInits = [] }
let emEnv = List.fold (buildModuleTypePass3 cenv modB) emEnv tdefs
let emEnv = (emEnv, tdefs) ||> Array.fold (buildModuleTypePass3 cenv modB)
let visited = new Dictionary<_,_>(10)
let created = new Dictionary<_,_>(10)
tdefs |> List.iter (buildModuleTypePass4 (visited,created) emEnv)
tdefs |> Array.iter (buildModuleTypePass4 (visited,created) emEnv)
let emEnv = Seq.fold envUpdateCreatedTypeRef emEnv created.Keys // update typT with the created typT
emitCustomAttrs cenv emEnv modB.SetCustomAttributeAndLog m.CustomAttrs;
m.Resources.AsList |> List.iter (fun r ->
......
......@@ -1008,10 +1008,9 @@ let GetTypeNameAsElemPair cenv n =
let rec GenTypeDefPass1 enc cenv (td:ILTypeDef) =
ignore (cenv.typeDefs.AddUniqueEntry "type index" (fun (TdKey (_,n)) -> n) (TdKey (enc,td.Name)))
GenTypeDefsPass1 (enc@[td.Name]) cenv td.NestedTypes.AsList
and GenTypeDefsPass1 enc cenv tds = List.iter (GenTypeDefPass1 enc cenv) tds
GenTypeDefsPass1 (enc@[td.Name]) cenv td.NestedTypes.AsArray
and GenTypeDefsPass1 enc cenv tds = Array.iter (GenTypeDefPass1 enc cenv) tds
//=====================================================================
// Pass 2 - allocate indexes for methods and fields and write rows for types
......@@ -1546,12 +1545,12 @@ and GenTypeDefPass2 pidx enc cenv (td:ILTypeDef) =
events |> List.iter (GenEventDefPass2 cenv tidx)
td.Fields.AsList |> List.iter (GenFieldDefPass2 cenv tidx)
td.Methods |> Seq.iter (GenMethodDefPass2 cenv tidx)
td.NestedTypes.AsList |> GenTypeDefsPass2 tidx (enc@[td.Name]) cenv
td.NestedTypes.AsArray |> GenTypeDefsPass2 tidx (enc@[td.Name]) cenv
with e ->
failwith ("Error in pass2 for type "+td.Name+", error: "+e.Message)
and GenTypeDefsPass2 pidx enc cenv tds =
List.iter (GenTypeDefPass2 pidx enc cenv) tds
Array.iter (GenTypeDefPass2 pidx enc cenv) tds
//=====================================================================
// Pass 3 - write details of methods, fields, IL code, custom attrs etc.
......@@ -3142,14 +3141,14 @@ let rec GenTypeDefPass3 enc cenv (td:ILTypeDef) =
td.SecurityDecls.AsList |> GenSecurityDeclsPass3 cenv (hds_TypeDef,tidx)
td.CustomAttrs |> GenCustomAttrsPass3Or4 cenv (hca_TypeDef,tidx)
td.GenericParams |> List.iteri (fun n gp -> GenGenericParamPass3 cenv env n (tomd_TypeDef,tidx) gp)
td.NestedTypes.AsList |> GenTypeDefsPass3 (enc@[td.Name]) cenv
td.NestedTypes.AsArray |> GenTypeDefsPass3 (enc@[td.Name]) cenv
with e ->
failwith ("Error in pass3 for type "+td.Name+", error: "+e.Message)
reraise()
raise e
and GenTypeDefsPass3 enc cenv tds =
List.iter (GenTypeDefPass3 enc cenv) tds
Array.iter (GenTypeDefPass3 enc cenv) tds
/// ILTypeDef --> generate generic params on ILMethodDef: ensures
/// GenericParam table is built sorted by owner.
......@@ -3160,14 +3159,14 @@ let rec GenTypeDefPass4 enc cenv (td:ILTypeDef) =
let tidx = GetIdxForTypeDef cenv (TdKey(enc,td.Name))
td.Methods |> Seq.iter (GenMethodDefPass4 cenv env)
List.iteri (fun n gp -> GenGenericParamPass4 cenv env n (tomd_TypeDef,tidx) gp) td.GenericParams
GenTypeDefsPass4 (enc@[td.Name]) cenv td.NestedTypes.AsList
GenTypeDefsPass4 (enc@[td.Name]) cenv td.NestedTypes.AsArray
with e ->
failwith ("Error in pass4 for type "+td.Name+", error: "+e.Message)
reraise()
raise e
and GenTypeDefsPass4 enc cenv tds =
List.iter (GenTypeDefPass4 enc cenv) tds
Array.iter (GenTypeDefPass4 enc cenv) tds
// --------------------------------------------------------------------
// ILExportedTypesAndForwarders --> ILExportedTypeOrForwarder table
......
......@@ -1088,7 +1088,7 @@ type TypeDefBuilder(tdef) =
Fields = mkILFields (tdef.Fields.AsList @ ResizeArray.toList gfields);
Properties = mkILProperties (tdef.Properties.AsList @ HashRangeSorted gproperties );
Events = mkILEvents (tdef.Events.AsList @ ResizeArray.toList gevents);
NestedTypes = mkILTypeDefs (tdef.NestedTypes.AsList @ gnested.Close()) }
NestedTypes = mkILTypeDefs (tdef.NestedTypes.AsList @ gnested.Close()) }
member b.AddEventDef(edef) = gevents.Add edef
......@@ -1120,11 +1120,11 @@ and TypeDefsBuilder() =
let tdef = b.Close()
// Skip the <PrivateImplementationDetails$> type if it is empty
if not eliminateIfEmpty
|| not tdef.NestedTypes.AsList.IsEmpty
|| tdef.NestedTypes.AsList.IsEmpty
|| not tdef.Fields.AsList.IsEmpty
|| not tdef.Events.AsList.IsEmpty
|| not tdef.Properties.AsList.IsEmpty
|| not tdef.Methods.AsList.IsEmpty then
|| tdef.Methods.AsList.Length <> 0 then
yield tdef ]
member b.FindTypeDefBuilder(nm) =
......@@ -3936,7 +3936,7 @@ and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod((TSlotSig(_,delega
let tcref = tcrefOfAppTy cenv.g delegateTy
let _,_,tdef = tcref.ILTyconInfo
match tdef.Methods.FindByName ".ctor" with
| [ctorMDef] ->
| [ ctorMDef ] ->
match ctorMDef.Parameters |> ILList.toList with
| [ _;p2 ] -> (p2.Type.TypeSpec.Name = "System.UIntPtr")
| _ -> false
......
......@@ -437,7 +437,7 @@ module private PrintIL =
let memberBlockLs (fieldDefs:ILFieldDefs, methodDefs:ILMethodDefs, propertyDefs:ILPropertyDefs, eventDefs:ILEventDefs) =
let ctors =
methodDefs.AsList
methodDefs.AsList
|> List.filter isPublicILCtor
|> List.sortBy (fun md -> md.Parameters.Length)
|> shrinkOverloads (layoutILMethodDef denv ilTyparSubst typeDef.Name) (fun _ xL -> xL)
......@@ -476,9 +476,9 @@ module private PrintIL =
let bodyStatic =
memberBlockLs (typeDef.Fields.AsList |> List.filter (fun fd -> fd.IsStatic) |> mkILFields,
typeDef.Methods.AsList |> List.filter (fun md -> md.IsStatic) |> mkILMethods,
typeDef.Properties.AsList |> List.filter (fun pd -> isStaticILProperty pd) |> mkILProperties,
typeDef.Events.AsList |> List.filter (fun ed -> isStaticILEvent ed) |> mkILEvents)
typeDef.Methods.AsList |> List.filter (fun md -> md.IsStatic) |> mkILMethods,
typeDef.Properties.AsList |> List.filter (fun pd -> isStaticILProperty pd) |> mkILProperties,
typeDef.Events.AsList |> List.filter (fun ed -> isStaticILEvent ed) |> mkILEvents)
let bodyInstance =
memberBlockLs (typeDef.Fields.AsList |> List.filter (fun fd -> not(fd.IsStatic)) |> mkILFields,
......@@ -492,7 +492,7 @@ module private PrintIL =
let body = applyMaxMembers denv.maxMembers body
let types =
typeDef.NestedTypes.AsList
typeDef.NestedTypes.AsList
|> List.filter isPublicILTypeDef
|> List.sortBy(fun t -> adjustILName t.Name)
|> List.map (layoutILNestedClassDef denv)
......
......@@ -971,8 +971,6 @@ module MainModuleBuilder =
let ilTypeDefs =
//let topTypeDef = mkILTypeDefForGlobalFunctions tcGlobals.ilg (mkILMethods [], emptyILFields)
mkILTypeDefs codegenResults.ilTypeDefs
let mainModule =
let hashAlg = AttributeHelpers.TryFindIntAttribute tcGlobals "System.Reflection.AssemblyAlgorithmIdAttribute" topAttrs.assemblyAttrs
......@@ -1310,7 +1308,7 @@ module StaticLinker =
{ ilxMainModule with
Manifest = (let m = ilxMainModule.ManifestOfAssembly in Some {m with CustomAttrs = mkILCustomAttrs (m.CustomAttrs.AsList @ savedManifestAttrs) });
CustomAttrs = mkILCustomAttrs [ for m in moduls do yield! m.CustomAttrs.AsList ];
TypeDefs = mkILTypeDefs (topTypeDef :: List.concat normalTypeDefs);
TypeDefs = mkILTypeDefs [ yield topTypeDef ; yield! List.concat normalTypeDefs ];
Resources = mkILResources (savedResources @ ilxMainModule.Resources.AsList);
NativeResources = savedNativeResources }
......@@ -1355,14 +1353,14 @@ module StaticLinker =
TypeDefs =
mkILTypeDefs
([ for td in fakeModule.TypeDefs do
yield {td with
yield {td with
Methods =
mkILMethods (List.map (fun (md:ILMethodDef) ->
{md with
CustomAttrs =
mkILCustomAttrs (td.CustomAttrs.AsList |> List.filter (fun ilattr ->
ilattr.Method.EnclosingType.TypeRef.FullName <> "System.Runtime.TargetedPatchingOptOutAttribute") )})
(td.Methods.AsList))}])}
td.Methods.AsList
|> List.map (fun md ->
{md with CustomAttrs =
mkILCustomAttrs (td.CustomAttrs.AsList |> List.filter (fun ilattr ->
ilattr.Method.EnclosingType.TypeRef.FullName <> "System.Runtime.TargetedPatchingOptOutAttribute") )})
|> mkILMethods } ])}
//ILAsciiWriter.output_module stdout fakeModule
fakeModule.TypeDefs.AsList
......@@ -1631,8 +1629,8 @@ module StaticLinker =
let rec rw enc (tdefs: ILTypeDefs) =
mkILTypeDefs
[ for tdef in tdefs do
let ilOrigTyRef = mkILNestedTyRef (ilOrigScopeRef, enc, tdef.Name)
if not (ilOrigTyRefsForProviderGeneratedTypesToRelocate.ContainsKey ilOrigTyRef) then
let ilOrigTyRef = mkILNestedTyRef (ilOrigScopeRef, enc, tdef.Name)
if not (ilOrigTyRefsForProviderGeneratedTypesToRelocate.ContainsKey ilOrigTyRef) then
if debugStaticLinking then printfn "Keep provided type %s in place because it wasn't relocated" ilOrigTyRef.QualifiedName
yield { tdef with NestedTypes = rw (enc@[tdef.Name]) tdef.NestedTypes } ]
rw [] ilModule.TypeDefs
......
......@@ -469,8 +469,9 @@ and ImportILTypeDefList amap m (cpath:CompilationPath) enc items =
///
and ImportILTypeDefs amap m scoref cpath enc (tdefs: ILTypeDefs) =
// We be very careful not to force a read of the type defs here
tdefs.AsListOfLazyTypeDefs
|> List.map (fun (ns,n,attrs,lazyTypeDef) -> (ns,(n,notlazy(scoref,attrs,lazyTypeDef))))
tdefs.AsArrayOfLazyTypeDefs
|> Array.map (fun (ns,n,attrs,lazyTypeDef) -> (ns,(n,notlazy(scoref,attrs,lazyTypeDef))))
|> Array.toList
|> ImportILTypeDefList amap m cpath enc
/// Import the main type definitions in an IL assembly.
......
......@@ -2983,7 +2983,7 @@ let GetImmediateIntrinsicMethInfosOfType (optFilter,ad) g amap m typ =
| ILTypeMetadata (_,tdef) ->
let mdefs = tdef.Methods
let mdefs = (match optFilter with None -> mdefs.AsList | Some nm -> mdefs.FindByName nm)
mdefs |> List.map (fun mdef -> MethInfo.CreateILMeth(amap, m, typ, mdef))
mdefs |> List.map (fun mdef -> MethInfo.CreateILMeth(amap, m, typ, mdef))
| FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata ->
if not (isAppTy g typ) then []
else SelectImmediateMemberVals g optFilter (TrySelectMemberVal g optFilter typ None) (tcrefOfAppTy g typ)
......
......@@ -1038,7 +1038,7 @@ let rec convClassUnionDef cenv enc td cud =
let isAbstract = (altTypeDefs.Length = cud.cudAlternatives.Length)
let existingMeths =
td.Methods.AsList
td.Methods.AsList
// Filter out the F#-compiler supplied implementation of the get_Empty method. This is because we will replace
// its implementation by one that loads the unique private static field for lists
|> List.filter (fun md -> not (cud.cudHasHelpers = SpecialFSharpListHelpers && (md.Name = "get_Empty" || md.Name = "Cons" || md.Name = "get_IsEmpty")) &&
......
Markdown is supported
0% .
You are about to add 0 people to the discussion. Proceed with caution.
先完成此消息的编辑!
想要评论请 注册