diff --git a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md index 632fcac6b93..baac02fbdc2 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md +++ b/docs/release-notes/.FSharp.Compiler.Service/11.0.100.md @@ -147,6 +147,7 @@ * Implied argument names for function-to-delegate coercions now fall back to the delegate's `Invoke` parameter names when the function has no recoverable names (e.g. a partial application like `System.Func((+) 1)`), instead of synthetic `delegateArg0`, `delegateArg1`, … names. ([PR #20001](https://github.com/dotnet/fsharp/pull/20001)) * Add internal `ResetCompilerGeneratedNameState` to `CompilerGlobalState` name generators so warm-checker re-compilation can produce fresh-process-identical generated names. ([PR #20017](https://github.com/dotnet/fsharp/pull/20017)) * Add Roslyn-format EnC CustomDebugInformation codec and portable PDB method CDI emission support to AbstractIL. ([PR #20018](https://github.com/dotnet/fsharp/pull/20018)) +* * IL: add `ILPreNamespace`, make `ILPreTypeDef` creation lazy ([PR #20092](https://github.com/dotnet/fsharp/pull/20092)) ### Improved diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index e2002731aa8..8ddb8b492de 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -2966,23 +2966,86 @@ type ILTypeDef override x.ToString() = "type " + x.Name -and [] ILTypeDefs(f: unit -> ILPreTypeDef[]) = - inherit DelayInitArrayMap(f) +// An entry's namespace is *relative to this level*: the full namespace for a flat table (all types at one +// level), empty for a grouped one (the tree encodes the path). Keeping it here rather than on the +// pre-type-def lets pre-type-defs store the same thing in either shape. +and [] ILTypeDefs + ( + f: unit -> struct (string list * ILPreTypeDef)[], + // Realised independently of the pre-type-defs, so importing some namespaces doesn't force others. + // Plain fields rather than an InterruptibleLazy: there is one ILTypeDefs per read type (its nested + // types) and per namespace level, and a level with no child namespaces pays nothing. + fNamespaces: unit -> ILPreNamespace[] + ) = + inherit DelayInitArrayMap(f) + + [] + let mutable namespacesStore: (ILPreNamespace array | null) = null + + let mutable fNamespaces = fNamespaces + + new(f: unit -> struct (string list * ILPreTypeDef)[]) = ILTypeDefs(f, Unchecked.defaultof<_>) override this.CreateDictionary(arr) = let t = Dictionary(arr.Length, HashIdentity.Structural) - for pre in arr do - let key = pre.Namespace, pre.Name - t[key] <- pre + for struct (ns, pre) in arr do + t[(ns, pre.Name)] <- pre ReadOnlyDictionary t + member private this.RealiseNamespaces() = + Monitor.Enter this + + try + match namespacesStore with + | NonNull nss -> nss + | _ -> + let nss = + match box fNamespaces with + | null -> Array.empty + | _ -> fNamespaces () + + namespacesStore <- nss + fNamespaces <- Unchecked.defaultof<_> + nss + finally + Monitor.Exit this + + member this.AsArrayOfPreNamespaces() = + match namespacesStore with + | NonNull nss -> nss + | _ -> this.RealiseNamespaces() + + /// This level's own pre-type-defs, then each child namespace's subtree - not the TypeDef row order for + /// a grouped table, since a namespace can be split across the metadata table. Consumers that need the + /// reader's order sort by ILTypeDef.MetadataIndex (see StaticLinking). + member x.AllPreTypeDefs() = + [| + for struct (_, pre) in x.GetArray() -> pre + for ns in x.AsArrayOfPreNamespaces() do + yield! ns.GetContents().AllPreTypeDefs() + |] + + /// Descends only into the namespace on the type's path, so unrelated namespaces are never forced. + member x.TryFindPreTypeDef(ns: string list, n: string) = + match x.GetDictionary().TryGetValue((ns, n)) with + | true, pre -> Some pre + | _ -> + match ns with + | [] -> None + | head :: rest -> + // Levels are narrow - in the framework reference assemblies 86% have a single child and the + // widest has 16 - so scanning beats keeping a per-level dictionary alive. + match x.AsArrayOfPreNamespaces() |> Array.tryFind (fun ns -> ns.Name = head) with + | Some ns -> ns.GetContents().TryFindPreTypeDef(rest, n) + | None -> None + member x.AsArray() = - [| for pre in x.GetArray() -> pre.GetTypeDef() |] + [| for pre in x.AllPreTypeDefs() -> pre.GetTypeDef() |] member x.AsList() = - [ for pre in x.GetArray() -> pre.GetTypeDef() ] + [ for pre in x.AllPreTypeDefs() -> pre.GetTypeDef() ] interface IEnumerable with member x.GetEnumerator() = @@ -2990,41 +3053,45 @@ and [] ILTypeDefs(f: unit -> ILPreTypeDef[]) = interface IEnumerable with member x.GetEnumerator() = - (seq { for pre in x.GetArray() -> pre.GetTypeDef() }).GetEnumerator() + (seq { for pre in x.AllPreTypeDefs() -> pre.GetTypeDef() }).GetEnumerator() member x.AsArrayOfPreTypeDefs() = x.GetArray() member x.FindByName nm = let ns, n = splitILTypeName nm - x.GetDictionary().[(ns, n)].GetTypeDef() + + match x.TryFindPreTypeDef(ns, n) with + | Some pre -> pre.GetTypeDef() + | None -> raise (KeyNotFoundException(nm)) member x.ExistsByName nm = let ns, n = splitILTypeName nm - x.GetDictionary().ContainsKey((ns, n)) + x.TryFindPreTypeDef(ns, n) |> Option.isSome and [] ILPreTypeDef = - abstract Namespace: string list abstract Name: string abstract GetTypeDef: unit -> ILTypeDef +and [] ILPreNamespace = + abstract Name: string + abstract GetContents: unit -> ILTypeDefs + /// This is a memory-critical class. Very many of these objects get allocated and held to represent the contents of .NET assemblies. -and [] ILPreTypeDefImpl(nameSpace: string list, name: string, metadataIndex: int32, storage: ILTypeDefStored) = - let stored = - lazy - match storage with - | ILTypeDefStored.Given td -> td - | ILTypeDefStored.Computed f -> f () - | ILTypeDefStored.Reader f -> f metadataIndex +and [] ILPreTypeDefImpl(name: string, metadataIndex: int32, storage: ILTypeDefStored) = + inherit DelayInitValue() + + override _.Compute() = + match storage with + | ILTypeDefStored.Given td -> td + | ILTypeDefStored.Reader f -> f metadataIndex interface ILPreTypeDef with - member _.Namespace = nameSpace member _.Name = name - member x.GetTypeDef() = stored.Value + member this.GetTypeDef() = this.Value and ILTypeDefStored = | Given of ILTypeDef | Reader of (int32 -> ILTypeDef) - | Computed of (unit -> ILTypeDef) let mkILTypeDefReader f = ILTypeDefStored.Reader f @@ -3413,26 +3480,142 @@ let mkRefForNestedILTypeDef scope (enc: ILTypeDef list, td: ILTypeDef) = // Operations on type tables. // -------------------------------------------------------------------- -let mkILPreTypeDef (td: ILTypeDef) = +let mkILPreTypeDefRead (n, idx, f) = + ILPreTypeDefImpl(n, idx, f) :> ILPreTypeDef + +let mkILPreTypeDefEntry (td: ILTypeDef) : struct (string list * ILPreTypeDef) = let ns, n = splitILTypeName td.Name - ILPreTypeDefImpl(ns, n, NoMetadataIdx, ILTypeDefStored.Given td) :> ILPreTypeDef + struct (ns, ILPreTypeDefImpl(n, NoMetadataIdx, ILTypeDefStored.Given td) :> ILPreTypeDef) + +/// A class rather than an object expression over a lazy: there is one namespace node per namespace of every +/// assembly read, so its wrapper objects add up. +[] +type private ILPreNamespaceImpl(name: string, f: unit -> ILTypeDefs) = + inherit DelayInitValue() + + let mutable f = f -let mkILPreTypeDefComputed (ns, n, f) = - ILPreTypeDefImpl(ns, n, NoMetadataIdx, ILTypeDefStored.Computed f) :> ILPreTypeDef + override _.Compute() = + let contents = f () + f <- Unchecked.defaultof<_> + contents -let mkILPreTypeDefRead (ns, n, idx, f) = - ILPreTypeDefImpl(ns, n, idx, f) :> ILPreTypeDef + interface ILPreNamespace with + member _.Name = name + member this.GetContents() = this.Value + +/// One level of a lazily grouped namespace tree, realising its own types and its child namespaces +/// separately. Holds the entries in fields rather than in closures over them, so a namespace that is never +/// imported stays a single object. +[] +type private ILPreNamespaceOfEntries<'Data>(name: string, levelEntries: struct (string list * 'Data)[], levelMk: 'Data -> ILPreTypeDef) = + inherit DelayInitValue() + + let mutable entries = levelEntries + let mutable mk = levelMk + + /// The entries that sit at the level itself. + static member Types(entries: struct (string list * 'Data)[], mk: 'Data -> ILPreTypeDef) = + [| + for struct (rem, data) in entries do + if List.isEmpty rem then + struct ([], mk data) + |] + + /// One child namespace per distinct leading component, in first-seen (metadata) order, so a namespace + /// split across the metadata table becomes a single child. + static member Namespaces(entries: struct (string list * 'Data)[], mk: 'Data -> ILPreTypeDef) = + let heads = ResizeArray() + let buckets = Dictionary>() + + for struct (rem, data) in entries do + match rem with + | [] -> () + | head :: rest -> + let bucket = + match buckets.TryGetValue head with + | true, bucket -> bucket + | _ -> + let bucket = ResizeArray() + heads.Add head + buckets[head] <- bucket + bucket + + bucket.Add(struct (rest, data)) + + [| + for head in heads -> ILPreNamespaceOfEntries<'Data>(head, buckets[head].ToArray(), mk) :> ILPreNamespace + |] + + override _.Compute() = + // Handed over to the level's thunks, so the entries are held only while the level still needs them. + let ownEntries = entries + let ownMk = mk + entries <- Unchecked.defaultof<_> + mk <- Unchecked.defaultof<_> + + ILTypeDefs( + (fun () -> ILPreNamespaceOfEntries<'Data>.Types(ownEntries, ownMk)), + (fun () -> ILPreNamespaceOfEntries<'Data>.Namespaces(ownEntries, ownMk)) + ) + + interface ILPreNamespace with + member _.Name = name + member this.GetContents() = this.Value + +let mkILPreNamespaceComputed (name, f) = + ILPreNamespaceImpl(name, f) :> ILPreNamespace let addILTypeDef td (tdefs: ILTypeDefs) = - ILTypeDefs(fun () -> [| yield mkILPreTypeDef td; yield! tdefs.AsArrayOfPreTypeDefs() |]) + ILTypeDefs( + (fun () -> [| yield mkILPreTypeDefEntry td; yield! tdefs.AsArrayOfPreTypeDefs() |]), + (fun () -> tdefs.AsArrayOfPreNamespaces()) + ) let mkILTypeDefsFromArray (l: ILTypeDef[]) = - ILTypeDefs(fun () -> Array.map mkILPreTypeDef l) + ILTypeDefs(fun () -> Array.map mkILPreTypeDefEntry l) let mkILTypeDefs l = mkILTypeDefsFromArray (Array.ofList l) let mkILTypeDefsComputed f = ILTypeDefs f +let mkILTypeDefsAndNamespacesComputed f (fNamespaces: unit -> ILPreNamespace[]) = ILTypeDefs(f, fNamespaces) + let emptyILTypeDefs = mkILTypeDefsFromArray [||] +let mkILTypeDefsGroupedComputed (f: unit -> struct (string list * 'Data)[]) (mk: 'Data -> ILPreTypeDef) = + // Only the top level defers the reader; it runs once across both thunks. A child level's entries are + // already in hand, computed when its parent's namespaces were realised. + let entries = InterruptibleLazy f + + let types () = + ILPreNamespaceOfEntries<'Data>.Types(entries.Value, mk) + + let namespaces () = + ILPreNamespaceOfEntries<'Data>.Namespaces(entries.Value, mk) + + mkILTypeDefsAndNamespacesComputed types namespaces + +let ilTypeDefsAsNamespaceLevel (tdefs: ILTypeDefs) = + let entries = tdefs.AsArrayOfPreTypeDefs() + + // A table's children come from its entries' namespaces (a flat table) or from its pre-namespaces (a + // grouped one, and every nested-type table), not from both - see mkILTypeDefsAndNamespacesComputed. + if entries |> Array.exists (fun (struct (ns, _)) -> not (List.isEmpty ns)) then + let levelTypes = + [| + for struct (ns, pre) in entries do + if List.isEmpty ns then + pre + |] + + let bucketed = ILPreNamespaceOfEntries.Namespaces(entries, id) + + // Should a reader supply both anyway, keep every child. + match tdefs.AsArrayOfPreNamespaces() with + | [||] -> struct (levelTypes, bucketed) + | preNamespaces -> struct (levelTypes, Array.append bucketed preNamespaces) + else + struct ([| for struct (_, pre) in entries -> pre |], tdefs.AsArrayOfPreNamespaces()) + let emptyILInterfaceImpls = InterruptibleLazy.FromValue([]) // -------------------------------------------------------------------- diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index 050921650c3..1ca47a4cb9f 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -1525,7 +1525,7 @@ type ILTypeDefAccess = /// Tables of named type definitions. [] type ILTypeDefs = - inherit DelayInitArrayMap + inherit DelayInitArrayMap interface IEnumerable @@ -1533,13 +1533,20 @@ type ILTypeDefs = member internal AsList: unit -> ILTypeDef list - /// Get some information about the type defs, but do not force the read of the type defs themselves. - member internal AsArrayOfPreTypeDefs: unit -> ILPreTypeDef[] + /// The entries at this level, each with its namespace relative to the level. Does not force the type + /// defs or the child namespaces. + member internal AsArrayOfPreTypeDefs: unit -> struct (string list * ILPreTypeDef)[] - /// Calls to FindByName will result in all the ILPreTypeDefs being read. + member internal AsArrayOfPreNamespaces: unit -> ILPreNamespace[] + + /// Every pre-type-def in the subtree, forcing all of it. + member internal AllPreTypeDefs: unit -> ILPreTypeDef[] + + /// Descends only into the type's own namespace, without forcing unrelated ones. Raises + /// KeyNotFoundException if not found. member internal FindByName: string -> ILTypeDef - /// Calls to ExistsByName will result in all the ILPreTypeDefs being read. + /// Descends only into the type's own namespace, without forcing unrelated ones. member internal ExistsByName: string -> bool [] @@ -1693,21 +1700,27 @@ type ILTypeDef = /// This information has to be "Goldilocks" - not too much, not too little, just right. [] type ILPreTypeDef = - abstract Namespace: string list abstract Name: string /// Realise the actual full typedef abstract GetTypeDef: unit -> ILTypeDef -[] +/// A namespace level realised on demand: its pre-type-defs are only created once it is imported. +[] +type ILPreNamespace = + abstract Name: string + abstract GetContents: unit -> ILTypeDefs + +[] type internal ILPreTypeDefImpl = + inherit DelayInitValue + interface ILPreTypeDef [] type internal ILTypeDefStored -val internal mkILPreTypeDef: ILTypeDef -> ILPreTypeDef -val internal mkILPreTypeDefComputed: string list * string * (unit -> ILTypeDef) -> ILPreTypeDef -val internal mkILPreTypeDefRead: string list * string * int32 * ILTypeDefStored -> ILPreTypeDef +val internal mkILPreTypeDefRead: string * int32 * ILTypeDefStored -> ILPreTypeDef +val mkILPreNamespaceComputed: string * (unit -> ILTypeDefs) -> ILPreNamespace val internal mkILTypeDefReader: (int32 -> ILTypeDef) -> ILTypeDefStored [] @@ -2369,7 +2382,25 @@ val emptyILTypeDefs: ILTypeDefs /// /// Note that individual type definitions may contain further delays /// in their method, field and other tables. -val mkILTypeDefsComputed: (unit -> ILPreTypeDef[]) -> ILTypeDefs +val mkILTypeDefsComputed: (unit -> struct (string list * ILPreTypeDef)[]) -> ILTypeDefs + +/// Like mkILTypeDefsComputed, but also supplies the level's immediate child namespaces, realised +/// independently of the type defs. +/// +/// A level names its children one way or the other: either its entries carry namespaces, or it supplies +/// pre-namespaces. With a name coming from both sources the level has two children of one name, and on +/// import one shadows the other. +val mkILTypeDefsAndNamespacesComputed: + (unit -> struct (string list * ILPreTypeDef)[]) -> (unit -> ILPreNamespace[]) -> ILTypeDefs + +/// Group namespaced entries into a lazy namespace tree, in first-seen (metadata) order. mk runs only +/// once the level an entry belongs to is realised, so an un-imported namespace's pre-type-defs never exist. +val mkILTypeDefsGroupedComputed: (unit -> struct (string list * 'Data)[]) -> ('Data -> ILPreTypeDef) -> ILTypeDefs + +/// A table as one namespace level: the pre-type-defs sitting at the level itself, plus its child +/// namespaces. A flat table's entries are bucketed by leading namespace component here, so an importer has +/// a single shape to walk; the children's own contents stay unrealised. +val internal ilTypeDefsAsNamespaceLevel: ILTypeDefs -> struct (ILPreTypeDef[] * ILPreNamespace[]) val internal addILTypeDef: ILTypeDef -> ILTypeDefs -> ILTypeDefs diff --git a/src/Compiler/AbstractIL/ilread.fs b/src/Compiler/AbstractIL/ilread.fs index 09fc311367a..d7cc7da4374 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -1888,7 +1888,9 @@ let rec seekReadModule (ctxt: ILMetadataReader) canReduceMemory (pectxtEager: PE MetadataIndex = idx Name = ilModuleName NativeResources = nativeResources - TypeDefs = mkILTypeDefsComputed (fun () -> seekReadTopTypeDefs ctxt) + TypeDefs = + mkILTypeDefsGroupedComputed (fun () -> seekReadTopTypeDefEntries ctxt) (fun (struct (nameIdx, i)) -> + mkILPreTypeDefRead (readStringHeap ctxt nameIdx, i, ctxt.typeDefReader)) SubSystemFlags = int32 subsys IsILOnly = ilOnly SubsystemVersion = subsysversion @@ -2055,14 +2057,6 @@ and seekIsTopTypeDefOfIdx ctxt idx = let flags, _, _, _, _, _ = seekReadTypeDefRow ctxt idx isTopTypeDef flags -and readBlobHeapAsSplitTypeName ctxt (nameIdx, namespaceIdx) = - let name = readStringHeap ctxt nameIdx - let nspace = readStringHeapOption ctxt namespaceIdx - - match nspace with - | Some nspace -> splitNamespace nspace, name - | None -> [], name - and readBlobHeapAsTypeName ctxt (nameIdx, namespaceIdx) = let name = readStringHeap ctxt nameIdx let nspace = readStringHeapOption ctxt namespaceIdx @@ -2082,16 +2076,6 @@ and seekReadTypeDefRowWithExtents ctxt (idx: int) = let info = seekReadTypeDefRow ctxt idx info, seekReadTypeDefRowExtents ctxt info idx -and seekReadPreTypeDef ctxt toponly (idx: int) = - let flags, nameIdx, namespaceIdx, _, _, _ = seekReadTypeDefRow ctxt idx - - if toponly && not (isTopTypeDef flags) then - None - else - let ns, n = readBlobHeapAsSplitTypeName ctxt (nameIdx, namespaceIdx) - // Return the ILPreTypeDef - Some(mkILPreTypeDefRead (ns, n, idx, ctxt.typeDefReader)) - and typeDefReader ctxtH : ILTypeDefStored = mkILTypeDefReader (fun idx -> let (ctxt: ILMetadataReader) = getHole ctxtH @@ -2233,12 +2217,20 @@ and typeDefReader ctxtH : ILTypeDefStored = metadataIndex = idx )) -and seekReadTopTypeDefs (ctxt: ILMetadataReader) = +// Reads only each row's namespace, for grouping; the name read and the pre-type-def build are deferred to +// the maker, so an un-imported namespace pays for neither. +and seekReadTopTypeDefEntries (ctxt: ILMetadataReader) = [| for i = 1 to ctxt.getNumRows TableNames.TypeDef do - match seekReadPreTypeDef ctxt true i with - | None -> () - | Some td -> yield td + let flags, nameIdx, namespaceIdx, _, _, _ = seekReadTypeDefRow ctxt i + + if isTopTypeDef flags then + let ns = + match readStringHeapOption ctxt namespaceIdx with + | Some nspace -> splitNamespace nspace + | None -> [] + + yield struct (ns, struct (nameIdx, i)) |] and seekReadNestedTypeDefs (ctxt: ILMetadataReader) tidx = @@ -2246,11 +2238,11 @@ and seekReadNestedTypeDefs (ctxt: ILMetadataReader) tidx = let nestedIdxs = seekReadIndexedRows (ctxt.getNumRows TableNames.Nested, seekReadNestedRow ctxt, snd, simpleIndexCompare tidx, false, fst) + // Nested types carry no namespace in metadata; they sit flat at the enclosing type's level. [| for i in nestedIdxs do - match seekReadPreTypeDef ctxt false i with - | None -> () - | Some td -> yield td + let _, nameIdx, _, _, _, _ = seekReadTypeDefRow ctxt i + yield struct ([], mkILPreTypeDefRead (readStringHeap ctxt nameIdx, i, ctxt.typeDefReader)) |]) and seekReadInterfaceImpls (ctxt: ILMetadataReader) mdv numTypars tidx = diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 9be3d04e58f..7ca4a9dc70f 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -1499,7 +1499,8 @@ let rec AddModuleOrNamespaceRefsToNameEnv g amap m root ad nenv (modrefs: Module let nenv = (nenv, modrefs) ||> List.fold (fun nenv modref -> - if modref.IsModule && EntityHasWellKnownAttribute g WellKnownEntityAttributes.AutoOpenAttribute modref.Deref then + // Check attributes before forcing the type reading. + if EntityHasWellKnownAttribute g WellKnownEntityAttributes.AutoOpenAttribute modref.Deref && modref.IsModule then AddModuleOrNamespaceContentsToNameEnv g amap ad m false nenv modref else nenv) diff --git a/src/Compiler/Checking/import.fs b/src/Compiler/Checking/import.fs index 86538b5c7ab..acdfa623164 100644 --- a/src/Compiler/Checking/import.fs +++ b/src/Compiler/Checking/import.fs @@ -235,16 +235,23 @@ module Nullness = { DirectAttributes: AttributesFromIL Fallback : NullableContextSource} with + // Matched rather than chained through ValueOption.orElseWith: that is not inline, so each call + // allocated a closure on a path walked per imported member. member this.GetFlags(g:TcGlobals) = - let fallback = this.Fallback - this.DirectAttributes.GetNullable(g) - |> ValueOption.orElseWith(fun () -> - match fallback with - | FromClass attrs -> attrs.GetNullableContext(g) - | FromMethodAndClass(methodCtx,classCtx) -> - methodCtx.GetNullableContext(g) - |> ValueOption.orElseWith (fun () -> classCtx.GetNullableContext(g))) - |> ValueOption.defaultValue arrayWithByte0 + match this.DirectAttributes.GetNullable(g) with + | ValueSome flags -> flags + | ValueNone -> + let fromContext = + match this.Fallback with + | FromClass attrs -> attrs.GetNullableContext(g) + | FromMethodAndClass(methodCtx,classCtx) -> + match methodCtx.GetNullableContext(g) with + | ValueSome flags -> ValueSome flags + | ValueNone -> classCtx.GetNullableContext(g) + + match fromContext with + | ValueSome flags -> flags + | ValueNone -> arrayWithByte0 static member Empty = let emptyFromIL = AttributesFromIL(0,ILAttributesStored.CreateGiven(ILAttributes.Empty)) {DirectAttributes = emptyFromIL; Fallback = FromClass(emptyFromIL)} @@ -666,93 +673,66 @@ let ImportILGenericParameters amap m scoref tinst (nullableFallback:Nullness.Nul tp.SetConstraints constraints) tps -/// Given a list of items each keyed by an ordered list of keys, apply 'nodef' to the each group -/// with the same leading key. Apply 'tipf' to the elements where the keylist is empty, and return -/// the overall results. Used to bucket types, so System.Char and System.Collections.Generic.List -/// both get initially bucketed under 'System'. -let multisetDiscriminateAndMap nodef tipf (items: ('Key list * 'Value) list) = - // Find all the items with an empty key list and call 'tipf' - let tips = - [ for keylist, v in items do - match keylist with - | [] -> yield tipf v - | _ -> () ] - - // Find all the items with a non-empty key list. Bucket them together by - // the first key. For each bucket, call 'nodef' on that head key and the bucket. - let nodes = - let buckets = Dictionary<_, _>(10) - for keylist, v in items do - match keylist with - | [] -> () - | key :: rest -> - buckets[key] <- - match buckets.TryGetValue key with - | true, b -> (rest, v) :: b - | _ -> [rest, v] - - [ for KeyValue(key, items) in buckets -> nodef key items ] - - tips @ nodes +/// Most IL types have no type parameters, so they share this value instead of each allocating a lazy plus a +/// closure over the nullable-context fallback, which is only needed when there is a parameter to import. +let private noTypars = LazyWithContext.NotLazy [] /// Import an IL type definition as a new F# TAST Entity node. let rec ImportILTypeDef amap m scoref (cpath: CompilationPath) enc nm (tdef: ILTypeDef) = - let lazyModuleOrNamespaceTypeForNestedTypes = - InterruptibleLazy(fun _ -> - let cpath = cpath.NestedCompPath nm ModuleOrType - ImportILTypeDefs amap m scoref cpath (enc@[tdef]) tdef.NestedTypes + let moduleOrNamespaceTypeForNestedTypes = + MaybeLazy.Lazy( + // Captures tdef, not its nested types: the closure then holds nothing the entity doesn't + // already keep alive. + InterruptibleLazy(fun _ -> + let cpath = cpath.NestedCompPath nm ModuleOrType + ImportILTypeDefs amap m scoref cpath (enc@[tdef]) tdef.NestedTypes + ) ) - let nullableFallback = Nullness.FromClass(Nullness.AttributesFromIL(tdef.MetadataIndex,tdef.CustomAttrsStored)) + let typars = + match tdef.GenericParams with + | [] -> noTypars + | gps -> + let nullableFallback = Nullness.FromClass(Nullness.AttributesFromIL(tdef.MetadataIndex,tdef.CustomAttrsStored)) + + // The read of the type parameters may fail to resolve types. Entity.Typars forces + // entity_typars with entity_range, so the range used here is always the import-time + // range 'm' passed to NewILTycon below — never a caller's ad-hoc source range. + // Make sure we reraise the original exception one occurs - see findOriginalException. + LazyWithContext.Create( + (fun m -> ImportILGenericParameters amap m scoref [] nullableFallback gps), + findOriginalException + ) // Add the type itself. Construct.NewILTycon (Some cpath) (nm, m) - // The read of the type parameters may fail to resolve types. Entity.Typars forces - // entity_typars with entity_range, so the range used here is always the import-time - // range 'm' passed to NewILTycon above — never a caller's ad-hoc source range. - // Make sure we reraise the original exception one occurs - see findOriginalException. - (LazyWithContext.Create( - (fun m -> ImportILGenericParameters amap m scoref [] nullableFallback tdef.GenericParams), - findOriginalException - )) + typars (scoref, enc, tdef) - (MaybeLazy.Lazy lazyModuleOrNamespaceTypeForNestedTypes) + moduleOrNamespaceTypeForNestedTypes -/// Import a list of (possibly nested) IL types as a new ModuleOrNamespaceType node -/// containing new entities, bucketing by namespace along the way. -and ImportILTypeDefList amap m (cpath: CompilationPath) enc items = - // Split into the ones with namespaces and without. Add the ones with namespaces in buckets. - // That is, discriminate based in the first element of the namespace list (e.g. "System") - // and, for each bag, fold-in a lazy computation to add the types under that bag . - // - // nodef - called for each bucket, where 'n' is the head element of the namespace used - // as a key in the discrimination, tgs is the remaining descriptors. We create an entity for 'n'. - // - // tipf - called if there are no namespace items left to discriminate on. - let entities = - items - |> multisetDiscriminateAndMap - (fun n tgs -> - let modty = InterruptibleLazy(fun _ -> ImportILTypeDefList amap m (cpath.NestedCompPath n (Namespace true)) enc tgs) - Construct.NewModuleOrNamespace (Some cpath) taccessPublic (mkSynId m n) XmlDoc.Empty [] (MaybeLazy.Lazy modty)) - (fun (n, info: InterruptibleLazy<_>) -> - let (scoref2, lazyTypeDef: ILPreTypeDef) = info.Force() - ImportILTypeDef amap m scoref2 cpath enc n (lazyTypeDef.GetTypeDef())) +/// Import a table of IL types as a ModuleOrNamespaceType. Each child namespace becomes a namespace entity +/// whose contents are imported the same way once forced. +and ImportILTypeDefs amap m scoref (cpath: CompilationPath) enc (tdefs: ILTypeDefs) = + // We be very careful not to force a read of the type defs or of the child namespaces' contents here + let struct (levelTypes, preNamespaces) = ilTypeDefsAsNamespaceLevel tdefs - let kind = match enc with [] -> Namespace true | _ -> ModuleOrType - Construct.NewModuleOrNamespaceType kind entities [] + let typeEntities = + [ for pre in levelTypes -> ImportILTypeDef amap m scoref cpath enc pre.Name (pre.GetTypeDef()) ] -/// Import a table of IL types as a ModuleOrNamespaceType. -/// -and ImportILTypeDefs amap m scoref cpath enc (tdefs: ILTypeDefs) = - // We be very careful not to force a read of the type defs here - tdefs.AsArrayOfPreTypeDefs() - |> Array.map (fun pre -> (pre.Namespace, (pre.Name, notlazy(scoref, pre)))) - |> Array.toList - |> ImportILTypeDefList amap m cpath enc + let namespaceEntities = + [ for preNamespace in preNamespaces do + let childCPath = cpath.NestedCompPath preNamespace.Name (Namespace true) + + let modty = + InterruptibleLazy(fun _ -> ImportILTypeDefs amap m scoref childCPath enc (preNamespace.GetContents())) + + Construct.NewModuleOrNamespace (Some cpath) taccessPublic (mkSynId m preNamespace.Name) XmlDoc.Empty [] (MaybeLazy.Lazy modty) ] + + let kind = match enc with [] -> Namespace true | _ -> ModuleOrType + Construct.NewModuleOrNamespaceType kind (typeEntities @ namespaceEntities) [] /// Import the main type definitions in an IL assembly. /// @@ -769,22 +749,22 @@ let ImportILAssemblyExportedType amap m auxModLoader (scoref: ILScopeRef) (expor [] else let ns, n = splitILTypeName exportedType.Name - let info = - InterruptibleLazy (fun _ -> - match - (try + + let pre = + { new ILPreTypeDef with + member _.Name = n + + member _.GetTypeDef() = + try let modul = auxModLoader exportedType.ScopeRef - let ptd = mkILPreTypeDefComputed (ns, n, (fun () -> modul.TypeDefs.FindByName exportedType.Name)) - Some ptd - with :? KeyNotFoundException -> None) - with - | None -> - error(Error(FSComp.SR.impReferenceToDllRequiredByAssembly(exportedType.ScopeRef.QualifiedName, scoref.QualifiedName, exportedType.Name), m)) - | Some preTypeDef -> - scoref, preTypeDef - ) + modul.TypeDefs.FindByName exportedType.Name + with :? KeyNotFoundException -> + error(Error(FSComp.SR.impReferenceToDllRequiredByAssembly(exportedType.ScopeRef.QualifiedName, scoref.QualifiedName, exportedType.Name), m)) } + + // A one-entry flat table: ilTypeDefsAsNamespaceLevel turns its namespace into the entity chain. + let tdefs = mkILTypeDefsComputed (fun () -> [| struct (ns, pre) |]) - [ ImportILTypeDefList amap m (CompPath(scoref, SyntaxAccess.Unknown, [])) [] [(ns, (n, info))] ] + [ ImportILTypeDefs amap m scoref (CompPath(scoref, SyntaxAccess.Unknown, [])) [] tdefs ] /// Import the "exported types" table for multi-module assemblies. let ImportILAssemblyExportedTypes amap m auxModLoader scoref (exportedTypes: ILExportedTypesAndForwarders) = diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index f0868919ad0..73b1502d53c 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -2341,6 +2341,13 @@ and [] TcImports let! ccuinfos = phase2s |> runMethod if importsBase.IsSome then + // Only F# assemblies can carry a trait constraint to label: an IL assembly's entities have no + // vals at all. Walking one would force every namespace of it - the whole point of importing + // namespaces lazily - to find nothing. + let addConstraintSources (ia: ImportedAssembly) = + if ia.FSharpViewOfMetadata.IsFSharp then + addConstraintSources ia + importsBase.Value.CcuTable.Values |> Seq.iter addConstraintSources ccuTable.Values |> Seq.iter addConstraintSources diff --git a/src/Compiler/Driver/StaticLinking.fs b/src/Compiler/Driver/StaticLinking.fs index ebc8287b974..f856e69df7c 100644 --- a/src/Compiler/Driver/StaticLinking.fs +++ b/src/Compiler/Driver/StaticLinking.fs @@ -214,7 +214,10 @@ let StaticLinkILModules let topTypeDefs, normalTypeDefs = moduls |> List.map (fun m -> + // A module read from metadata groups its type defs by namespace, which is not the TypeDef + // row order when a namespace is split across the table. Emit them as read instead. m.TypeDefs.AsList() + |> List.sortBy (fun td -> td.MetadataIndex) |> List.partition (fun td -> isTypeNameForGlobalFunctions td.Name)) |> List.unzip diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 1686f36aa28..043214817b4 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/src/Compiler/TypedTree/TypedTree.fs @@ -905,8 +905,12 @@ type Entity = member x.IsFSharpException = match x.ExceptionInfo with TExnNone -> false | _ -> true /// Demangle the module name, if FSharpModuleWithSuffix is used - member x.DemangledModuleOrNamespaceName = - CompilationPath.DemangleEntityName x.LogicalName x.ModuleOrNamespaceType.ModuleOrNamespaceKind + member x.DemangledModuleOrNamespaceName = + // Check the suffix before reading the entity contents. + if x.LogicalName.EndsWithOrdinal FSharpModuleSuffix then + CompilationPath.DemangleEntityName x.LogicalName x.ModuleOrNamespaceType.ModuleOrNamespaceKind + else + x.LogicalName /// Get the type parameters for an entity that is a type declaration, otherwise return the empty list. /// @@ -6206,8 +6210,9 @@ type Construct() = ModuleOrNamespaceType(mkind, QueueList.ofList vals, QueueList.ofList tycons) /// Create a new node for an empty module or namespace contents - static member NewEmptyModuleOrNamespaceType mkind = - Construct.NewModuleOrNamespaceType mkind [] [] + static member NewEmptyModuleOrNamespaceType mkind = + // Not via NewModuleOrNamespaceType: QueueList.ofList would build two more objects to hold nothing. + ModuleOrNamespaceType(mkind, QueueList.Empty, QueueList.Empty) static member NewEmptyFSharpTyconData kind = { fsobjmodel_cases = Construct.MakeUnionCases [] diff --git a/src/Compiler/Utilities/illib.fs b/src/Compiler/Utilities/illib.fs index fe091c640b3..6e536e9e4a6 100644 --- a/src/Compiler/Utilities/illib.fs +++ b/src/Compiler/Utilities/illib.fs @@ -197,6 +197,34 @@ type DelayInitArrayMap<'T, 'TDictKey, 'TDictValue>(f: unit -> 'T[]) = abstract CreateDictionary: 'T[] -> IDictionary<'TDictKey, 'TDictValue> +[] +type DelayInitValue<'T when 'T: not null and 'T: not struct>() = + // Locks the instance rather than a private sync object, and stores in place rather than in a lazy: + // either would add an object per value, and there is one of these per type and per namespace of every + // assembly read. + [] + let mutable value: objnull = null + + abstract Compute: unit -> 'T + + member private this.Realise() = + Monitor.Enter this + + try + match value with + | null -> + let computed = this.Compute() + value <- box computed + computed + | v -> unbox<'T> v + finally + Monitor.Exit this + + member this.Value = + match value with + | null -> this.Realise() + | v -> unbox<'T> v + //------------------------------------------------------------------------- // Library: projections //------------------------------------------------------------------------ diff --git a/src/Compiler/Utilities/illib.fsi b/src/Compiler/Utilities/illib.fsi index a200812b3bd..0a1a2100645 100644 --- a/src/Compiler/Utilities/illib.fsi +++ b/src/Compiler/Utilities/illib.fsi @@ -85,6 +85,19 @@ type DelayInitArrayMap<'T, 'TDictKey, 'TDictValue> = abstract CreateDictionary: 'T[] -> IDictionary<'TDictKey, 'TDictValue> +/// Computes a value once, in place. Unlike a lazy, the state the computation needs lives in the derived +/// object itself, so an unforced value costs one object rather than a lazy plus its closure - which matters +/// where very many of them are allocated and held, as for the contents of .NET assemblies. +[] +type internal DelayInitValue<'T when 'T: not null and 'T: not struct> = + new: unit -> DelayInitValue<'T> + + /// The computed value, computing it on the first call. + member Value: 'T + + /// Called at most once, under the instance's lock. An exception is not cached: the next access retries. + abstract Compute: unit -> 'T + module internal Order = val orderBy: p: ('T -> 'U) -> IComparer<'T> when 'U: comparison and 'T: not null and 'T: not struct diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl index cd6be26fa07..05f5248a7a8 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.bsl @@ -1263,9 +1263,10 @@ FSharp.Compiler.AbstractIL.IL+ILPlatform: Int32 CompareTo(System.Object, System. FSharp.Compiler.AbstractIL.IL+ILPlatform: Int32 GetHashCode() FSharp.Compiler.AbstractIL.IL+ILPlatform: Int32 GetHashCode(System.Collections.IEqualityComparer) FSharp.Compiler.AbstractIL.IL+ILPlatform: System.String ToString() +FSharp.Compiler.AbstractIL.IL+ILPreNamespace: ILTypeDefs GetContents() +FSharp.Compiler.AbstractIL.IL+ILPreNamespace: System.String Name +FSharp.Compiler.AbstractIL.IL+ILPreNamespace: System.String get_Name() FSharp.Compiler.AbstractIL.IL+ILPreTypeDef: ILTypeDef GetTypeDef() -FSharp.Compiler.AbstractIL.IL+ILPreTypeDef: Microsoft.FSharp.Collections.FSharpList`1[System.String] Namespace -FSharp.Compiler.AbstractIL.IL+ILPreTypeDef: Microsoft.FSharp.Collections.FSharpList`1[System.String] get_Namespace() FSharp.Compiler.AbstractIL.IL+ILPreTypeDef: System.String Name FSharp.Compiler.AbstractIL.IL+ILPreTypeDef: System.String get_Name() FSharp.Compiler.AbstractIL.IL+ILPropertyDef: Boolean IsRTSpecialName @@ -1652,7 +1653,7 @@ FSharp.Compiler.AbstractIL.IL+ILTypeDefLayout: Int32 GetHashCode(System.Collecti FSharp.Compiler.AbstractIL.IL+ILTypeDefLayout: Int32 Tag FSharp.Compiler.AbstractIL.IL+ILTypeDefLayout: Int32 get_Tag() FSharp.Compiler.AbstractIL.IL+ILTypeDefLayout: System.String ToString() -FSharp.Compiler.AbstractIL.IL+ILTypeDefs: System.Collections.Generic.IDictionary`2[System.Tuple`2[Microsoft.FSharp.Collections.FSharpList`1[System.String],System.String],FSharp.Compiler.AbstractIL.IL+ILPreTypeDef] CreateDictionary(ILPreTypeDef[]) +FSharp.Compiler.AbstractIL.IL+ILTypeDefs: System.Collections.Generic.IDictionary`2[System.Tuple`2[Microsoft.FSharp.Collections.FSharpList`1[System.String],System.String],FSharp.Compiler.AbstractIL.IL+ILPreTypeDef] CreateDictionary(System.ValueTuple`2[Microsoft.FSharp.Collections.FSharpList`1[System.String],FSharp.Compiler.AbstractIL.IL+ILPreTypeDef][]) FSharp.Compiler.AbstractIL.IL+ILTypeInit+Tags: Int32 BeforeField FSharp.Compiler.AbstractIL.IL+ILTypeInit+Tags: Int32 OnAny FSharp.Compiler.AbstractIL.IL+ILTypeInit: Boolean Equals(ILTypeInit) @@ -1892,6 +1893,7 @@ FSharp.Compiler.AbstractIL.IL: FSharp.Compiler.AbstractIL.IL+ILNestedExportedTyp FSharp.Compiler.AbstractIL.IL: FSharp.Compiler.AbstractIL.IL+ILNestedExportedTypes FSharp.Compiler.AbstractIL.IL: FSharp.Compiler.AbstractIL.IL+ILParameter FSharp.Compiler.AbstractIL.IL: FSharp.Compiler.AbstractIL.IL+ILPlatform +FSharp.Compiler.AbstractIL.IL: FSharp.Compiler.AbstractIL.IL+ILPreNamespace FSharp.Compiler.AbstractIL.IL: FSharp.Compiler.AbstractIL.IL+ILPreTypeDef FSharp.Compiler.AbstractIL.IL: FSharp.Compiler.AbstractIL.IL+ILPropertyDef FSharp.Compiler.AbstractIL.IL: FSharp.Compiler.AbstractIL.IL+ILPropertyDefs @@ -1944,6 +1946,7 @@ FSharp.Compiler.AbstractIL.IL: ILMethodImplDefs mkILMethodImpls(Microsoft.FSharp FSharp.Compiler.AbstractIL.IL: ILMethodImplDefs mkILMethodImplsLazy(System.Lazy`1[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+ILMethodImplDef]]) FSharp.Compiler.AbstractIL.IL: ILModuleDef mkILSimpleModule(System.String, System.String, Boolean, System.Tuple`2[System.Int32,System.Int32], Boolean, ILTypeDefs, Microsoft.FSharp.Core.FSharpOption`1[System.Int32], Microsoft.FSharp.Core.FSharpOption`1[System.String], Int32, ILExportedTypesAndForwarders, System.String) FSharp.Compiler.AbstractIL.IL: ILNestedExportedTypes mkILNestedExportedTypes(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+ILNestedExportedType]) +FSharp.Compiler.AbstractIL.IL: ILPreNamespace mkILPreNamespaceComputed(System.String, Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,FSharp.Compiler.AbstractIL.IL+ILTypeDefs]) FSharp.Compiler.AbstractIL.IL: ILPropertyDefs emptyILProperties FSharp.Compiler.AbstractIL.IL: ILPropertyDefs get_emptyILProperties() FSharp.Compiler.AbstractIL.IL: ILPropertyDefs mkILProperties(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+ILPropertyDef]) @@ -1958,7 +1961,9 @@ FSharp.Compiler.AbstractIL.IL: ILSecurityDeclsStored storeILSecurityDecls(ILSecu FSharp.Compiler.AbstractIL.IL: ILTypeDefs emptyILTypeDefs FSharp.Compiler.AbstractIL.IL: ILTypeDefs get_emptyILTypeDefs() FSharp.Compiler.AbstractIL.IL: ILTypeDefs mkILTypeDefs(Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+ILTypeDef]) -FSharp.Compiler.AbstractIL.IL: ILTypeDefs mkILTypeDefsComputed(Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,FSharp.Compiler.AbstractIL.IL+ILPreTypeDef[]]) +FSharp.Compiler.AbstractIL.IL: ILTypeDefs mkILTypeDefsAndNamespacesComputed(Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,System.ValueTuple`2[Microsoft.FSharp.Collections.FSharpList`1[System.String],FSharp.Compiler.AbstractIL.IL+ILPreTypeDef][]], Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,FSharp.Compiler.AbstractIL.IL+ILPreNamespace[]]) +FSharp.Compiler.AbstractIL.IL: ILTypeDefs mkILTypeDefsComputed(Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,System.ValueTuple`2[Microsoft.FSharp.Collections.FSharpList`1[System.String],FSharp.Compiler.AbstractIL.IL+ILPreTypeDef][]]) +FSharp.Compiler.AbstractIL.IL: ILTypeDefs mkILTypeDefsGroupedComputed[Data](Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,System.ValueTuple`2[Microsoft.FSharp.Collections.FSharpList`1[System.String],Data][]], Microsoft.FSharp.Core.FSharpFunc`2[Data,FSharp.Compiler.AbstractIL.IL+ILPreTypeDef]) FSharp.Compiler.AbstractIL.IL: ILTypeDefs mkILTypeDefsFromArray(ILTypeDef[]) FSharp.Compiler.AbstractIL.IL: Int32 NoMetadataIdx FSharp.Compiler.AbstractIL.IL: Int32 get_NoMetadataIdx() diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj index 5b589936a98..3818a54d46c 100644 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj @@ -34,6 +34,7 @@ + diff --git a/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs b/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs index b05e8f5864e..6df21337507 100644 --- a/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs +++ b/tests/FSharp.Compiler.Service.Tests/ModuleReaderCancellationTests.fs @@ -10,6 +10,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.CodeAnalysis +open FSharp.Compiler.Diagnostics open FSharp.Compiler.Text open FSharp.Test.Assert open Internal.Utilities.Library @@ -124,17 +125,17 @@ type PreTypeDef(data: PreTypeDefData) = interface ILPreTypeDef with member x.Name = data.Name - member x.Namespace = data.Namespace member x.GetTypeDef() = getTypeDef () -let createPreTypeDefs typeData = +// A flat table: each entry pairs the type's namespace with the pre-type-def (all at one level). +let createPreTypeDefs typeData : struct (string list * ILPreTypeDef)[] = typeData |> Array.ofList - |> Array.map (fun data -> PreTypeDef data :> ILPreTypeDef) + |> Array.map (fun data -> struct (data.Namespace, PreTypeDef data :> ILPreTypeDef)) -let referenceReaderProject getPreTypeDefs (cancelOnModuleAccess: bool) (options: FSharpProjectOptions) = - let reader = new ModuleReader("Reference", mkILTypeDefsComputed getPreTypeDefs, cancelOnModuleAccess) +let referenceReaderProjectWithTypeDefs (typeDefs: ILTypeDefs) (cancelOnModuleAccess: bool) (options: FSharpProjectOptions) = + let reader = new ModuleReader("Reference", typeDefs, cancelOnModuleAccess) let project = FSharpReferencedProject.ILModuleReference( reader.Path, (fun _ -> reader.Timestamp), (fun _ -> reader) @@ -142,6 +143,9 @@ let referenceReaderProject getPreTypeDefs (cancelOnModuleAccess: bool) (options: { options with ReferencedProjects = [| project |]; OtherOptions = Array.append options.OtherOptions [| $"-r:{reader.Path}"|] } +let referenceReaderProject getPreTypeDefs (cancelOnModuleAccess: bool) (options: FSharpProjectOptions) = + referenceReaderProjectWithTypeDefs (mkILTypeDefsComputed getPreTypeDefs) cancelOnModuleAccess options + let parseAndCheck path source options = cts <- new CancellationTokenSource() wasCancelled <- false @@ -211,8 +215,7 @@ let ``Type defs 01 - assembly import`` () = | None -> failwith "Expecting results" -// can only be run explicitly -[] +[] let ``Type defs 02 - assembly import`` () = let source = source1 @@ -300,3 +303,135 @@ let ``Module def 01 - assembly import`` () = |> shouldEqual [| "No constructors are available for the type 'T'" |] | None -> failwith "Expecting results" + + +// A namespace split across the metadata (Ns1.Ns2 broken by the intervening Ns1.T2) must merge into +// one namespace on import, and the import order must be preserved. These use the synthetic reader +// above so the split order is under our control (Roslyn can't emit a genuinely split namespace). +let private splitNamespaceTypes = + [ { Name = "T1"; Namespace = ["Ns1"; "Ns2"]; HasCtor = false; CancelOnImport = false } + { Name = "T2"; Namespace = ["Ns1"]; HasCtor = false; CancelOnImport = false } + { Name = "T3"; Namespace = ["Ns1"; "Ns2"]; HasCtor = false; CancelOnImport = false } ] + +[] +let ``Split namespace - both fragments merge and are accessible`` () = + // open Ns1.Ns2 must bring in both T1 and T3, even though they are split by Ns1.T2 in the metadata. + let source = """ +module Module + +open Ns1 +open Ns1.Ns2 + +let _f1 (x: T1) = x +let _f2 (x: T2) = x +let _f3 (x: T3) = x +""" + let getPreTypeDefs _ = createPreTypeDefs splitNamespaceTypes + let path, options = mkTestFileAndOptions [||] + let options = referenceReaderProject getPreTypeDefs false options + + match parseAndCheck path source options with + | Some results -> + results.Diagnostics + |> Array.filter (fun d -> d.Severity = FSharpDiagnosticSeverity.Error) + |> Array.map _.Message + |> shouldEqual [||] + | None -> failwith "Expecting results" + +/// The synthetic reference assembly, analysed as a whole project. +let private referencedAssembly (options: FSharpProjectOptions) = + let results = checker.ParseAndCheckProject(options) |> Async.RunSynchronously + + results.ProjectContext.GetReferencedAssemblies() + |> List.find (fun a -> a.SimpleName.StartsWith "Reference") + +/// The imported types in entity order, each as "Namespace.Path.TypeName". +let private importedTypeOrder (options: FSharpProjectOptions) = + (referencedAssembly options).Contents.Entities + |> Seq.map (fun e -> if e.AccessPath = "global" then e.DisplayName else $"{e.AccessPath}.{e.DisplayName}") + |> List.ofSeq + +[] +let ``Split namespace - import order is preserved`` () = + let getPreTypeDefs _ = createPreTypeDefs splitNamespaceTypes + let _, options = mkTestFileAndOptions [||] + let options = referenceReaderProject getPreTypeDefs false options + + // Depth-first: Ns1's own type T2 first, then the merged Ns1.Ns2 with T1 before T3 (metadata order). + // Verified to be the same order the pre-ILPreNamespace import produced for this shape - though see + // the ordering tests below: that parity is a coincidence of this shape's namespace depths. + (referencedAssembly options).Contents.Entities + |> Seq.map (fun e -> e.DisplayName, e.AccessPath) + |> List.ofSeq + |> shouldEqual [ "T2", "Ns1"; "T1", "Ns1.Ns2"; "T3", "Ns1.Ns2" ] + + +// ---- Entity order ------------------------------------------------------------------------------ +// +// Types at namespace depths 0-3, with sibling types at each depth, two sibling namespaces inside Ns1 +// and a second top-level namespace - enough to pin sibling order at every depth for both reader shapes. +let private orderedTypes = + [ "G0", [] + "G1", [] + "A1", [ "N1" ] + "B1", [ "N1" ] + "A2", [ "N1"; "N2" ] + "B2", [ "N1"; "N2" ] + "A3", [ "N1"; "N2"; "N3" ] + "B3", [ "N1"; "N2"; "N3" ] + "PA", [ "N1"; "P" ] + "QA", [ "N1"; "Q" ] + "C1", [ "M1" ] ] + +let private mkTypeData (name, ns) = + { Name = name; Namespace = ns; HasCtor = false; CancelOnImport = false } + +/// Metadata order at every depth, types before child namespaces. +/// +/// NOTE: this is a deliberate change from the pre-ILPreNamespace import, which bucketed types by +/// prepending into a dictionary and so reversed siblings once per namespace component consumed - its +/// order alternated with depth: "N1.B1, N1.A1" and namespaces "N1.Q, N1.P, N1.N2", but "N1.N2.A2, +/// N1.N2.B2" and then "N1.N2.N3.B3, N1.N2.N3.A3" again. +/// +/// That order cannot be kept now that both reader shapes exist: in a grouped tree a type is an item of +/// exactly one level, so it would be reversed once whatever its depth, while a flat table reverses it +/// once per component. Metadata order is the only order the two shapes can agree on - which is why +/// both tests below assert the same list. +let private expectedOrder = + [ "G0" + "G1" + "N1.A1" + "N1.B1" + "N1.N2.A2" + "N1.N2.B2" + "N1.N2.N3.A3" + "N1.N2.N3.B3" + "N1.P.PA" + "N1.Q.QA" + "M1.C1" ] + +[] +let ``Import order - flat reader keeps metadata order at every depth`` () = + // A flat table: every entry at one level, carrying its full namespace (the shape custom readers, + // FSI and static linking produce, and the only shape that existed before ILPreNamespace). + let typeDefs = + mkILTypeDefsComputed (fun () -> createPreTypeDefs (List.map mkTypeData orderedTypes)) + + let _, options = mkTestFileAndOptions [||] + let options = referenceReaderProjectWithTypeDefs typeDefs false options + + importedTypeOrder options |> shouldEqual expectedOrder + +[] +let ``Import order - grouped reader keeps metadata order at every depth`` () = + // A lazy namespace tree, the shape the default file reader produces. It must import in exactly the + // same order as the flat table above. + let typeDefs = + mkILTypeDefsGroupedComputed + (fun () -> [| for name, ns in orderedTypes -> struct (ns, mkTypeData (name, ns)) |]) + (fun data -> PreTypeDef data :> ILPreTypeDef) + + let _, options = mkTestFileAndOptions [||] + let options = referenceReaderProjectWithTypeDefs typeDefs false options + + importedTypeOrder options |> shouldEqual expectedOrder diff --git a/tests/FSharp.Compiler.Service.Tests/ModuleReaderNamespaceTests.fs b/tests/FSharp.Compiler.Service.Tests/ModuleReaderNamespaceTests.fs new file mode 100644 index 00000000000..ff579fe7c37 --- /dev/null +++ b/tests/FSharp.Compiler.Service.Tests/ModuleReaderNamespaceTests.fs @@ -0,0 +1,676 @@ +module FSharp.Compiler.Service.Tests.ModuleReaderNamespaceTests + +open System.Collections.Generic +open System.Reflection +open System.Text +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AbstractIL.ILBinaryReader +open FSharp.Compiler.Diagnostics +open FSharp.Compiler.Service.Tests.Common +// The synthetic ILModuleReader harness (ModuleReader, referenceReaderProjectWithTypeDefs). +open FSharp.Compiler.Service.Tests.ModuleReaderCancellationTests +open FSharp.Test.Compiler +open FSharp.Test.Assert +open Xunit + +// These tests exercise how ILPreTypeDef / ILPreNamespace are created when reading .NET metadata: the +// goal is lazy namespace reading, where only imported namespaces realise their pre-type-defs. +// +// Roslyn groups emitted types by namespace and doesn't preserve source order across namespaces, so C# +// can't produce a genuinely "split" namespace (e.g. Ns1, Ns2, Ns1). C# is therefore used only for the +// realistic-shape test (siblings sorted); split-namespace order is asserted with synthetic arrays. + +/// Render the namespace/type tree using the structural API. +let private dumpTree (sortSiblings: bool) (typeDefs: ILTypeDefs) : string = + let sb = StringBuilder() + + let rec go (indent: int) (tds: ILTypeDefs) = + let pad = String.replicate indent " " + + let typeNames = + [ for struct (_, pre) in tds.AsArrayOfPreTypeDefs() do + // Skip the always-present pseudo-type. + if pre.Name <> "" then yield pre.Name ] + for name in (if sortSiblings then List.sort typeNames else typeNames) do + sb.AppendLine($"{pad}{name}") |> ignore + + let namespaces = List.ofArray (tds.AsArrayOfPreNamespaces()) + let namespaces = if sortSiblings then List.sortBy (fun (ns: ILPreNamespace) -> ns.Name) namespaces else namespaces + for ns in namespaces do + sb.AppendLine($"{pad}{ns.Name}/") |> ignore + go (indent + 1) (ns.GetContents()) + + sb.AppendLine("global") |> ignore + go 1 typeDefs + sb.ToString().Replace("\r\n", "\n").TrimEnd('\n') + + +// ---- Synthetic pre-type-defs (control the exact metadata order) -------------------------------- + +/// A pre-type-def carrying only its simple name; the namespace lives in the containing table. +let private mkPreTypeDef (name: string) : ILPreTypeDef = + { new ILPreTypeDef with + member _.Name = name + member _.GetTypeDef() = + ILTypeDef(name, TypeAttributes.Public, ILTypeDefLayout.Auto, [], [], None, + mkILMethods [], mkILTypeDefs [], mkILFields [], emptyILMethodImpls, mkILEvents [], + mkILProperties [], emptyILSecurityDecls, emptyILCustomAttrsStored) } + +/// A flat-table entry from a full type name: its namespace paired with the pre-type-def (all types +/// sit at one level). +let private flatEntry (fullName: string) : struct (string list * ILPreTypeDef) = + let ns, name = splitILTypeName fullName + struct (ns, mkPreTypeDef name) + +/// Group the given full type names (in order) into a namespace tree using the production grouping. +let private mkGroupedTypeDefs (fullNames: string list) : ILTypeDefs = + mkILTypeDefsGroupedComputed + (fun () -> [| for n in fullNames -> let ns, name = splitILTypeName n in struct (ns, name) |]) + mkPreTypeDef + +/// Wrap the type defs so that forcing any namespace's contents records its full path in `forced`. +let private trackNamespaceForcing (forced: HashSet) (typeDefs: ILTypeDefs) : ILTypeDefs = + let rec track (path: string) (tds: ILTypeDefs) = + mkILTypeDefsAndNamespacesComputed + (fun () -> tds.AsArrayOfPreTypeDefs()) + (fun () -> + [| for ns in tds.AsArrayOfPreNamespaces() -> + let nsPath = if path = "" then ns.Name else $"{path}.{ns.Name}" + mkILPreNamespaceComputed(ns.Name, fun () -> + forced.Add nsPath |> ignore + track nsPath (ns.GetContents())) |]) + + track "" typeDefs + + +[] +let ``Grouping - split namespace preserves metadata order`` () = + // Ns1 is split in the metadata: Ns1.T1, then Ns2.T2, then back to Ns1.T3. + let typeDefs = mkGroupedTypeDefs [ "Ns1.T1"; "Ns2.T2"; "Ns1.T3" ] + + // Ns1 must come before Ns2 (first-seen), and within Ns1 the members keep order: T1 then T3. + dumpTree false typeDefs |> shouldEqual ( + "global\n" + + " Ns1/\n" + + " T1\n" + + " T3\n" + + " Ns2/\n" + + " T2" + ) + + +[] +let ``Grouping - nested namespaces and global types`` () = + let typeDefs = + mkGroupedTypeDefs [ "Type1"; "Namespace1.Type2"; "Namespace2.Inner.Type4"; "Namespace2.Type3" ] + + dumpTree false typeDefs |> shouldEqual ( + "global\n" + + " Type1\n" + + " Namespace1/\n" + + " Type2\n" + + " Namespace2/\n" + + " Type3\n" + + " Inner/\n" + + " Type4" + ) + + +[] +let ``Grouping - flat compat members flatten across namespaces`` () = + let typeDefs = mkGroupedTypeDefs [ "Type1"; "Ns1.T1"; "Ns2.T2"; "Ns1.T3" ] + + // AllPreTypeDefs flattens the whole subtree (local types first, then per-namespace in order). + typeDefs.AllPreTypeDefs() |> Array.map _.Name |> shouldEqual [| "Type1"; "T1"; "T3"; "T2" |] + + typeDefs.ExistsByName "Ns1.T3" |> shouldEqual true + typeDefs.ExistsByName "Ns2.T2" |> shouldEqual true + typeDefs.ExistsByName "Missing" |> shouldEqual false + (typeDefs.FindByName "Ns1.T1").Name |> shouldEqual "T1" + + +[] +let ``Grouping - namespaces are realised lazily`` () = + let forced = HashSet() + + let typeDefs = + trackNamespaceForcing forced (mkGroupedTypeDefs [ "Type1"; "Ns1.T1"; "Ns2.Inner.T2" ]) + + // Reading global-namespace types and enumerating child namespaces must not force any contents. + typeDefs.AsArrayOfPreTypeDefs() |> Array.map (fun struct (_, p) -> p.Name) |> shouldEqual [| "Type1" |] + typeDefs.AsArrayOfPreNamespaces() |> Array.map _.Name |> shouldEqual [| "Ns1"; "Ns2" |] + forced.Count |> shouldEqual 0 + + // Importing a single namespace forces only that one (not its siblings, not deeper levels). + let ns1 = typeDefs.AsArrayOfPreNamespaces() |> Array.find (fun ns -> ns.Name = "Ns1") + ns1.GetContents().AsArrayOfPreTypeDefs() |> Array.map (fun struct (_, p) -> p.Name) |> shouldEqual [| "T1" |] + forced.Contains "Ns1" |> shouldEqual true + forced.Contains "Ns2" |> shouldEqual false + forced.Contains "Ns2.Inner" |> shouldEqual false + + +[] +let ``Grouping - pre-type-defs of un-imported namespaces are never built`` () = + // The maker for a type runs only once its namespace level is realised, so grouping and enumerating + // namespaces never touches an un-imported namespace's types. + let built = HashSet() + + let entry (fullName: string) : struct (string list * string) = + struct (fst (splitILTypeName fullName), fullName) + + let mk (fullName: string) = + built.Add fullName |> ignore + mkPreTypeDef (snd (splitILTypeName fullName)) + + let typeDefs = + mkILTypeDefsGroupedComputed (fun () -> [| entry "Type1"; entry "Ns1.T1"; entry "Ns2.Inner.T2" |]) mk + + // Enumerating child namespace names builds nothing: types and namespaces realise independently. + typeDefs.AsArrayOfPreNamespaces() |> Array.map _.Name |> shouldEqual [| "Ns1"; "Ns2" |] + built |> shouldEqual (HashSet()) + + // Reading the global-namespace types builds only those. + typeDefs.AsArrayOfPreTypeDefs() |> Array.map (fun struct (_, p) -> p.Name) |> shouldEqual [| "Type1" |] + built |> shouldEqual (HashSet [ "Type1" ]) + + // Importing Ns1 builds only Ns1's types; Ns2's remain untouched. + let ns1 = typeDefs.AsArrayOfPreNamespaces() |> Array.find (fun ns -> ns.Name = "Ns1") + ns1.GetContents().AsArrayOfPreTypeDefs() |> Array.map (fun struct (_, p) -> p.Name) |> shouldEqual [| "T1" |] + built |> shouldEqual (HashSet [ "Type1"; "Ns1.T1" ]) + + +[] +let ``Lookup - by name works for flat readers (namespaced pre-type-defs)`` () = + // A flat table: all entries at the top level, each carrying its full namespace. + let typeDefs = mkILTypeDefsComputed (fun () -> [| flatEntry "Ns1.Ns2.T"; flatEntry "GlobalType" |]) + + typeDefs.ExistsByName "Ns1.Ns2.T" |> shouldEqual true + typeDefs.ExistsByName "GlobalType" |> shouldEqual true + typeDefs.ExistsByName "Ns1.T" |> shouldEqual false + (typeDefs.FindByName "Ns1.Ns2.T").Name |> shouldEqual "T" + + +[] +let ``Lookup - by name descends only into the relevant namespace`` () = + let forced = HashSet() + let typeDefs = trackNamespaceForcing forced (mkGroupedTypeDefs [ "Ns1.T1"; "Ns2.Inner.T2" ]) + + // Finding a type descends only into the namespaces on its path, not its siblings. + typeDefs.ExistsByName "Ns2.Inner.T2" |> shouldEqual true + forced.Contains "Ns2" |> shouldEqual true + forced.Contains "Ns2.Inner" |> shouldEqual true + forced.Contains "Ns1" |> shouldEqual false + + // A miss under an existing namespace does not force siblings either. + typeDefs.ExistsByName "Ns2.Nope" |> shouldEqual false + forced.Contains "Ns1" |> shouldEqual false + + +[] +let ``Lookup - FindByName reports the missing type name`` () = + let typeDefs = mkGroupedTypeDefs [ "Ns1.T1" ] + + Assert.Throws(fun () -> typeDefs.FindByName "Ns1.Missing" |> ignore).Message + |> shouldEqual "Ns1.Missing" + + +[] +let ``Hybrid level - lookup and flattening see both sources`` () = + // A level carrying BOTH namespaced flat entries and a child pre-namespace of the same name. No + // reader produces this - a level names its children one way or the other, see + // mkILTypeDefsAndNamespacesComputed - but lookup and flattening still take in both sources. + let ns2 = + mkILPreNamespaceComputed("Ns2", fun () -> mkILTypeDefsComputed (fun () -> [| struct ([], mkPreTypeDef "TDeepGrouped") |])) + + let ns1 = + mkILPreNamespaceComputed( + "Ns1", + fun () -> mkILTypeDefsAndNamespacesComputed (fun () -> [| struct ([], mkPreTypeDef "TGrouped") |]) (fun () -> [| ns2 |]) + ) + + let typeDefs = + mkILTypeDefsAndNamespacesComputed + (fun () -> + [| struct ([ "Ns1" ], mkPreTypeDef "TFlat") + struct ([ "Ns1"; "Ns2" ], mkPreTypeDef "TDeepFlat") |]) + (fun () -> [| ns1 |]) + + // The flat entries hit this level's own dictionary; the grouped ones are found by descending. + typeDefs.ExistsByName "Ns1.TFlat" |> shouldEqual true + typeDefs.ExistsByName "Ns1.TGrouped" |> shouldEqual true + typeDefs.ExistsByName "Ns1.Ns2.TDeepFlat" |> shouldEqual true + typeDefs.ExistsByName "Ns1.Ns2.TDeepGrouped" |> shouldEqual true + typeDefs.ExistsByName "Ns1.Missing" |> shouldEqual false + + // Flattening unions both sources: this level's entries first, then each namespace's subtree. + typeDefs.AllPreTypeDefs() + |> Array.map _.Name + |> shouldEqual [| "TFlat"; "TDeepFlat"; "TGrouped"; "TDeepGrouped" |] + + +[] +let ``Duplicate namespace nodes - lookup sees the first, flattening sees all`` () = + // mkILTypeDefsGroupedComputed merges a split namespace into one node, so no reader should hand the + // same level two namespaces with one name. This pins the documented fallback if one ever does. + let mkNs name typeName = + mkILPreNamespaceComputed(name, fun () -> mkILTypeDefsComputed (fun () -> [| struct ([], mkPreTypeDef typeName) |])) + + let typeDefs = + mkILTypeDefsAndNamespacesComputed (fun () -> [||]) (fun () -> [| mkNs "Ns" "First"; mkNs "Ns" "Second" |]) + + typeDefs.ExistsByName "Ns.First" |> shouldEqual true + typeDefs.ExistsByName "Ns.Second" |> shouldEqual false + + typeDefs.AllPreTypeDefs() |> Array.map _.Name |> shouldEqual [| "First"; "Second" |] + + +// ---- C# realistic-shape path (reads real metadata via ILModuleReader) -------------------------- + +let private readCSharpModule (source: string) : ILModuleDef = + let dllPath = + CSharp source + |> withName "NamespaceReaderTest" + |> compile + |> shouldSucceed + |> fun result -> + match result.OutputPath with + | Some path -> path + | None -> failwith "Expected an output path from the C# compilation" + + let options = + { pdbDirPath = None + reduceMemoryUsage = ReduceMemoryFlag.Yes + metadataOnly = MetadataOnlyFlag.Yes + tryGetMetadataSnapshot = (fun _ -> None) } + + (OpenILModuleReader dllPath options).ILModuleDef + + +[] +let ``Grouping - reader groups real metadata into namespaces (C#)`` () = + let source = """ +public class Type1 { } +namespace Namespace1 { public class Type2 { } } +namespace Namespace2 { public class Type3 { } } +namespace Namespace2.Inner { public class Type4 { } } +""" + + // Sibling order is normalised: Roslyn does not preserve source order across namespaces. + dumpTree true (readCSharpModule source).TypeDefs |> shouldEqual ( + "global\n" + + " Type1\n" + + " Namespace1/\n" + + " Type2\n" + + " Namespace2/\n" + + " Type3\n" + + " Inner/\n" + + " Type4" + ) + + +[] +let ``Nested types - live under their declaring type, not as namespaces (C#)`` () = + let source = """ +namespace Ns { public class Outer { public class Inner { public class Innermost { } } } } +""" + + let moduleDef = readCSharpModule source + + // The tree only exposes namespaces and top-level types: nested types are not namespaces. + dumpTree true moduleDef.TypeDefs |> shouldEqual ( + "global\n" + + " Ns/\n" + + " Outer" + ) + + // Nested types are reachable through their declaring type's NestedTypes, keyed by simple name. + let outer = moduleDef.TypeDefs.FindByName "Ns.Outer" + outer.NestedTypes.AsArray() |> Array.map (fun td -> td.Name) |> shouldEqual [| "Inner" |] + outer.NestedTypes.AsArrayOfPreNamespaces() |> shouldEqual [||] + + let inner = outer.NestedTypes.FindByName "Inner" + inner.NestedTypes.AsArray() |> Array.map (fun td -> td.Name) |> shouldEqual [| "Innermost" |] + + +[] +let ``Nested types - grouping keeps them under the declaring type`` () = + // A top-level type in a namespace, carrying a nested type in its (namespace-free) NestedTypes. + let inner = + ILTypeDef("Inner", TypeAttributes.NestedPublic, ILTypeDefLayout.Auto, [], [], None, + mkILMethods [], mkILTypeDefs [], mkILFields [], emptyILMethodImpls, mkILEvents [], + mkILProperties [], emptyILSecurityDecls, emptyILCustomAttrsStored) + + let outer : ILPreTypeDef = + { new ILPreTypeDef with + member _.Name = "Outer" + member _.GetTypeDef() = + ILTypeDef("Outer", TypeAttributes.Public, ILTypeDefLayout.Auto, [], [], None, + mkILMethods [], mkILTypeDefs [ inner ], mkILFields [], emptyILMethodImpls, mkILEvents [], + mkILProperties [], emptyILSecurityDecls, emptyILCustomAttrsStored) } + + let typeDefs = mkILTypeDefsGroupedComputed (fun () -> [| struct ([ "Ns" ], outer) |]) id + + // Outer sits in namespace Ns; Inner is not a top-level type or namespace. + dumpTree false typeDefs |> shouldEqual ( + "global\n" + + " Ns/\n" + + " Outer" + ) + + let nsContents = (typeDefs.AsArrayOfPreNamespaces() |> Array.exactlyOne).GetContents() + let struct (_, outerPre) = nsContents.AsArrayOfPreTypeDefs() |> Array.exactlyOne + outerPre.GetTypeDef().NestedTypes.AsArray() |> Array.map (fun td -> td.Name) |> shouldEqual [| "Inner" |] + + +// ---- End-to-end: what checking a file actually reads out of a reference ------------------------ +// +// The tests above pin the reader API in isolation. These pin the guarantee it exists for: checking a +// file must pull only the namespaces it names out of a referenced assembly. A regression is easy to +// introduce far from the reader - anything that walks a CCU's whole ModuleOrNamespaceType realises +// every namespace of it, and every type in them (addConstraintSources in CompilerImports did exactly +// that for every referenced assembly, F# or not). + +/// A type to put in the synthetic reference assembly. +type private TypeShape = + { Name: string + Namespace: string list + /// Names of the types nested in it (leaves themselves). + Nested: string list + /// Full name of a base type in the same assembly. + Extends: string option } + +let private shape name ns = + { Name = name; Namespace = ns; Nested = []; Extends = None } + +let private fullName ns name = String.concat "." (ns @ [ name ]) + +/// Resolved by simple name against the project's references, so System.Object can be named. +let private systemRuntimeScopeRef = + ILScopeRef.Assembly(ILAssemblyRef.Create("System.Runtime", None, None, false, None, None)) + +/// What a check pulled out of the reference, by full type name ("Ns.T", nested as "Ns.T+Inner"). +type private ReadLog() = + member val TypeDefs = HashSet() + member val Members = HashSet() + member val NestedTypes = HashSet() + member val CustomAttrs = HashSet() + +let private sorted (names: HashSet) = List.ofSeq names |> List.sort + +/// A pre-type-def that records reading its type def, and each part of it read afterwards. +/// +/// `ilName` follows the reader's convention: a top-level type def carries its full name (that is what +/// readBlobHeapAsTypeName gives it) while the pre-type-def carries the simple one; a nested type def +/// carries the simple name, since nested rows have no namespace. Import rebuilds a nested type's +/// ILTypeRef from its declaring type def's name, so a simple name there resolves in the wrong namespace. +let rec private trackedPreTypeDefWith + (log: ReadLog) + (attributes: TypeAttributes) + (ilName: string) + (path: string) + (ty: TypeShape) + : ILPreTypeDef = + let methods = + mkILMethodsComputed (fun () -> + log.Members.Add path |> ignore + [||]) + + let nested = + mkILTypeDefsComputed (fun () -> + log.NestedTypes.Add path |> ignore + + [| for name in ty.Nested -> + struct ([], + trackedPreTypeDefWith log TypeAttributes.NestedPublic name $"{path}+{name}" (shape name [])) |]) + + let customAttrs = + ILAttributesStored.CreateReader( + 0, + fun _ -> + log.CustomAttrs.Add path |> ignore + [||] + ) + + // A type with no base type of its own still derives from System.Object, as any class emitted by a + // compiler does - otherwise a member lookup on it has no hierarchy to walk and simply fails. + let extends = + let scope, name = + match ty.Extends with + | Some name -> ILScopeRef.Local, name + | None -> systemRuntimeScopeRef, "System.Object" + + Some(mkILBoxedType (mkILNonGenericTySpec (mkILTyRef (scope, name)))) + + // One instance, as a real reader's pre-type-def hands out: import holds on to the one it was given. + let typeDef = + ILTypeDef(ilName, attributes, ILTypeDefLayout.Auto, [], [], extends, + methods, nested, mkILFields [], emptyILMethodImpls, mkILEvents [], + mkILProperties [], emptyILSecurityDecls, customAttrs) + + { new ILPreTypeDef with + member _.Name = ty.Name + + member _.GetTypeDef() = + log.TypeDefs.Add path |> ignore + typeDef } + +let private trackedPreTypeDef log (ty: TypeShape) = + let path = fullName ty.Namespace ty.Name + trackedPreTypeDefWith log TypeAttributes.Public path path ty + +/// Check `source` against a reference assembly built from `shapes`, and report what it read. +let private checkAgainstReference (shapes: TypeShape list) (source: string) = + let log = ReadLog() + + let typeDefs = + mkILTypeDefsComputed (fun () -> + [| for s in shapes -> struct (s.Namespace, trackedPreTypeDef log s) |]) + + let path, options = mkTestFileAndOptions [||] + let options = referenceReaderProjectWithTypeDefs typeDefs false options + + let _, results = parseAndCheckFile path source options + + results.Diagnostics + |> Array.filter (fun d -> d.Severity = FSharpDiagnosticSeverity.Error) + |> Array.map _.Message + |> shouldEqual [||] + + log + +/// Types at several namespace depths, with a sibling at each and a nested type in Ns1.A. +let private referenceShapes = + [ shape "G" [] + { shape "A" [ "Ns1" ] with Nested = [ "Inner" ] } + shape "B" [ "Ns1" ] + shape "D" [ "Ns1"; "Deep" ] + shape "X" [ "Ns2" ] ] + +let private useNs1A = """ +module Module + +let f (x: Ns1.A) = x +""" + +[] +let ``Laziness - checking a file reads only the namespaces it names`` () = + let log = checkAgainstReference referenceShapes useNs1A + + // Ns1.B comes along with Ns1.A, and G with the root level that names Ns1: import granularity is the + // namespace level, not the type, since building an entity for one type needs its ILTypeDef. What + // matters is that the levels not on the path - Ns1.Deep and Ns2 - are never read. + sorted log.TypeDefs |> shouldEqual [ "G"; "Ns1.A"; "Ns1.B" ] + +[] +let ``Laziness - checking a file builds no pre-type-def for un-named namespaces (grouped reader)`` () = + let log = ReadLog() + let built = HashSet() + + // The lazy namespace tree the file reader produces (the test above uses the flat shape of custom + // readers and FSI). Here even building the pre-type-def is deferred to the level, so an un-imported + // namespace costs nothing beyond its own name. + let typeDefs = + mkILTypeDefsGroupedComputed + (fun () -> [| for s in referenceShapes -> struct (s.Namespace, s) |]) + (fun s -> + let path = fullName s.Namespace s.Name + built.Add path |> ignore + trackedPreTypeDef log s) + + let path, options = mkTestFileAndOptions [||] + let options = referenceReaderProjectWithTypeDefs typeDefs false options + parseAndCheckFile path useNs1A options |> ignore + + sorted built |> shouldEqual [ "G"; "Ns1.A"; "Ns1.B" ] + sorted log.TypeDefs |> shouldEqual [ "G"; "Ns1.A"; "Ns1.B" ] + +[] +let ``Laziness - importing a type reads neither its members nor its nested types`` () = + let log = checkAgainstReference referenceShapes useNs1A + + // Reading a type def is the whole cost of importing it: what is inside stays behind its own lazies. + sorted log.Members |> shouldEqual [] + sorted log.NestedTypes |> shouldEqual [] + +[] +let ``Laziness - attributes are read for the types brought into scope, not for all imported ones`` () = + let log = checkAgainstReference referenceShapes useNs1A + + // A type's attributes are read when it enters the name environment (an entry has to be checked for + // RequireQualifiedAccess and for extension members) or when a use of it is resolved (Obsolete and + // friends are reported there). G is at the root level, which is in scope everywhere; Ns1.A is named. + // Ns1.B is imported alongside Ns1.A but never enters scope, so its attributes stay unread. + sorted log.CustomAttrs |> shouldEqual [ "G"; "Ns1.A" ] + +[] +let ``Laziness - a nested type is read only once it is named`` () = + let source = """ +module Module + +let f (x: Ns1.A.Inner) = x +""" + let log = checkAgainstReference referenceShapes source + + // Naming the nested type forces its declaring type's nested table - and only that one. + sorted log.NestedTypes |> shouldEqual [ "Ns1.A" ] + sorted log.TypeDefs |> shouldEqual [ "G"; "Ns1.A"; "Ns1.A+Inner"; "Ns1.B" ] + sorted log.Members |> shouldEqual [] + +[] +let ``Laziness - opening a namespace does not read its child namespaces`` () = + let source = """ +module Module + +open Ns1 + +let f (x: A) = x +""" + let log = checkAgainstReference referenceShapes source + + // An open imports the namespace's own types, so Ns1.Deep must stay untouched. + sorted log.TypeDefs |> shouldEqual [ "G"; "Ns1.A"; "Ns1.B" ] + + // The open brings every type of Ns1 into scope, so unlike the qualified use above it does read the + // attributes of all of them - that is the price of an open, and it is bounded by the namespace. + sorted log.CustomAttrs |> shouldEqual [ "G"; "Ns1.A"; "Ns1.B" ] + +[] +let ``Laziness - a deep type reads only the levels on its path`` () = + let source = """ +module Module + +let f (x: Ns1.Deep.D) = x +""" + let log = checkAgainstReference referenceShapes source + + // Ns1 is on the path so its own types come too; Ns2 is not. + sorted log.TypeDefs |> shouldEqual [ "G"; "Ns1.A"; "Ns1.B"; "Ns1.Deep.D" ] + +[] +let ``Laziness - a reference nothing names reads only its root level`` () = + let source = """ +module Module + +let x = 1 +""" + let log = checkAgainstReference referenceShapes source + + // The floor: the root level is realised for every reference, because the initial name resolution + // environment names its root namespaces. Nothing below it is touched. + sorted log.TypeDefs |> shouldEqual [ "G" ] + +let private withBaseTypeShapes = + [ { shape "A" [ "Ns1" ] with Extends = Some "Ns2.Base" } + shape "Base" [ "Ns2" ] + shape "X" [ "Ns2" ] + shape "D" [ "Ns1"; "Deep" ] ] + +[] +let ``Laziness - the base type of an imported type is not read`` () = + let log = checkAgainstReference withBaseTypeShapes useNs1A + + // Importing Ns1.A only records its base type as an ILType; the entity behind it is resolved when + // something needs the hierarchy. Naming the type in a signature doesn't, so Ns2 stays unread - + // note there is no global type here, so even the root level costs nothing. + sorted log.TypeDefs |> shouldEqual [ "Ns1.A" ] + +[] +let ``Laziness - a member lookup reads the base type's namespace`` () = + let source = """ +module Module + +let f (x: Ns1.A) = x.ToString() +""" + let log = checkAgainstReference withBaseTypeShapes source + + // A member lookup walks the hierarchy, so the base type is imported - which realises its namespace + // level, bringing Ns2.X with it. Ns1.Deep is still not on any path. + sorted log.TypeDefs |> shouldEqual [ "Ns1.A"; "Ns2.Base"; "Ns2.X" ] + sorted log.Members |> shouldEqual [ "Ns1.A"; "Ns2.Base" ] + + +// ---- Row indices let a flattened read module be put back into metadata order ------------------- + +/// The full names of a module's top-level types, in raw metadata TypeDef table order. +let private metadataTypeDefOrder (path: string) = + use fs = System.IO.File.OpenRead path + use pe = new System.Reflection.PortableExecutable.PEReader(fs) + let md = System.Reflection.Metadata.PEReaderExtensions.GetMetadataReader pe + + [ for handle in md.TypeDefinitions do + let td: System.Reflection.Metadata.TypeDefinition = md.GetTypeDefinition handle + // Nested types have their own rows; ILTypeDefs only holds top-level ones. + if td.GetDeclaringType().IsNil then + let ns = md.GetString td.Namespace + let name = md.GetString td.Name + yield (if ns = "" then name else ns + "." + name) ] + +[] +let ``Reading - sorting a flattened module by row index gives the metadata TypeDef order`` () = + // Flattening (AsArray/AsList/the enumerator) walks namespace by namespace, so it does *not* reproduce + // the TypeDef table order - a namespace can be split across the table. Consumers that need the + // reader's order sort by MetadataIndex; static linking does, so that --standalone emits the types of + // a dependent assembly in its original order. Pin both halves of that contract here. + // + // FSharp.Core is the right subject: F#-compiled assemblies routinely split a namespace across the + // TypeDef table (Roslyn-compiled ones group it, which would make this test vacuous). + let path = typeof.Assembly.Location + let metadataOrder = metadataTypeDefOrder path + + let options = + { pdbDirPath = None + reduceMemoryUsage = ReduceMemoryFlag.Yes + metadataOnly = MetadataOnlyFlag.Yes + tryGetMetadataSnapshot = (fun _ -> None) } + + let moduleDef = (OpenILModuleReader path options).ILModuleDef + let typeDefs = moduleDef.TypeDefs.AsList() + + // ILTypeDef.Name for a top-level type read from metadata is the full "Namespace.Name". + // Every row is there, but the namespace walk hands them back in a different order. + let names = typeDefs |> List.map _.Name + List.sort names |> shouldEqual (List.sort metadataOrder) + Assert.True(names <> metadataOrder, "flattening happened to match row order, so the sort below proves nothing") + + // List.sortBy is stable, so row indices alone restore the order the rows were read in. + typeDefs |> List.sortBy (fun td -> td.MetadataIndex) |> List.map _.Name |> shouldEqual metadataOrder diff --git a/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/FSharp.Compiler.Benchmarks.fsproj b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/FSharp.Compiler.Benchmarks.fsproj index d23efc28b99..5251526efa2 100644 --- a/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/FSharp.Compiler.Benchmarks.fsproj +++ b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/FSharp.Compiler.Benchmarks.fsproj @@ -14,6 +14,7 @@ + diff --git a/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/NamespaceImportBenchmarks.fs b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/NamespaceImportBenchmarks.fs new file mode 100644 index 00000000000..dcafac7c524 --- /dev/null +++ b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/NamespaceImportBenchmarks.fs @@ -0,0 +1,484 @@ +namespace FSharp.Compiler.Benchmarks + +open System +open System.IO +open FSharp.Compiler.CodeAnalysis +open FSharp.Compiler.Diagnostics +open FSharp.Compiler.Text +open FSharp.Compiler.AbstractIL.ILBinaryReader +open BenchmarkDotNet.Attributes +open FSharp.Benchmarks.Common.Categories + +// These benchmarks target the lazy-namespace work in the IL reader (ILPreNamespace): importing an +// assembly should only realise the namespaces the code actually touches, so a project that references +// large *non-F#* assemblies (the BCL) but opens only a couple of namespaces should read and retain less. +// +// Only non-F# assemblies exercise this path: F# assemblies are unpickled from FSharpSignatureData and +// never build ILPreNamespace trees. Scripts pull in the whole framework, giving us the large-reference +// surface for free. +// +// "Narrow" opens one namespace; "Wide" opens many. The narrow case is where laziness should pay off; +// the wide case is the control that should stay flat (no regression when everything is forced anyway). +[] +module private NamespaceImportHelpers = + + let narrowSource = + """module Bench.Narrow +open System +let s: String = String.Empty +let sb = StringComparer.Ordinal""" + + let wideSource = + """module Bench.Wide +open System +open System.Collections +open System.Collections.Generic +open System.Diagnostics +open System.Globalization +open System.IO +open System.Reflection +open System.Runtime.InteropServices +open System.Text +open System.Threading +open System.Threading.Tasks +let s: String = String.Empty +let l = List() +let d = Dictionary() +let sb = StringBuilder() +let ci = CultureInfo.InvariantCulture +let ms = new MemoryStream()""" + + /// Options with the full framework referenced, so the reader has many namespaces to (not) realise. + let getScriptOptions (checker: FSharpChecker) (fileName: string) (source: string) = + let options, diagnostics = + checker.GetProjectOptionsFromScript(fileName, SourceText.ofString source, assumeDotNetFramework = false, useSdkRefs = true) + |> Async.RunSynchronously + if diagnostics |> List.exists (fun (d: FSharpDiagnostic) -> d.Severity = FSharpDiagnosticSeverity.Error) then + failwithf "script options had errors: %A" diagnostics + options + + let check (checker: FSharpChecker) (fileName: string) (source: string) (options: FSharpProjectOptions) = + let _, answer = + checker.ParseAndCheckFileInProject(fileName, 0, SourceText.ofString source, options) + |> Async.RunSynchronously + match answer with + | FSharpCheckFileAnswer.Aborted -> failwith "check aborted" + | FSharpCheckFileAnswer.Succeeded results -> + let errors = results.Diagnostics |> Array.filter (fun d -> d.Severity = FSharpDiagnosticSeverity.Error) + if errors.Length > 0 then failwithf "check had errors: %A" errors + answer + + /// Cold-start type-check: a brand-new checker with an empty IL reader cache, so the assemblies are + /// read and their namespace trees built from scratch. This is the "analysis startup" cost. + let coldCheck (fileName: string) (source: string) (options: FSharpProjectOptions) = + ClearAllILModuleReaderCache() + let checker = FSharpChecker.Create(projectCacheSize = 200) + check checker fileName source options |> ignore + checker + + let consoleAppSource = + """module Program +open System +[] +let main argv = + Console.WriteLine("Hello, World!") + let sum = [ 1 .. 10 ] |> List.map (fun x -> x * x) |> List.sum + Console.WriteLine(sum) + 0""" + + /// fsc argv that compiles the console app as an exe against the resolved framework references. + /// `extraArgs` lets callers add flags like `--times` without duplicating the setup. + let buildConsoleAppArgv (checker: FSharpChecker) (extraArgs: string list) = + let dir = Path.Combine(Path.GetTempPath(), "fcsConsoleAppBench") + Directory.CreateDirectory(dir) |> ignore + let sourceFile = Path.Combine(dir, "Program.fs") + File.WriteAllText(sourceFile, consoleAppSource) + let outFile = Path.Combine(dir, "Program.exe") + let options = getScriptOptions checker (Path.Combine(dir, "resolve.fsx")) "let x = 1" + let refs = options.OtherOptions |> Array.filter (fun o -> o.StartsWith "-r:") + [| yield "fsc.dll" + yield! refs + yield "--noframework" + yield "--target:exe" + yield "--optimize+" + yield "--out:" + outFile + yield! extraArgs + yield sourceFile |] + +/// Startup time + transient allocation for a cold type-check. MemoryDiagnoser reports allocated +/// bytes/op: fewer ILPreNamespace/ILPreTypeDef closures built for un-opened namespaces shows up here. +[] +[] +type NamespaceImportStartupBenchmarks() = + + let narrowFile = "narrow.fsx" + let wideFile = "wide.fsx" + let mutable narrowOptions = Unchecked.defaultof + let mutable wideOptions = Unchecked.defaultof + + [] + member _.Setup() = + // Resolving script references is expensive and unrelated to what we measure; do it once up front. + let checker = FSharpChecker.Create() + narrowOptions <- getScriptOptions checker narrowFile narrowSource + wideOptions <- getScriptOptions checker wideFile wideSource + + [] + member _.NarrowImport() = + coldCheck narrowFile narrowSource narrowOptions |> ignore + + [] + member _.WideImport() = + coldCheck wideFile wideSource wideOptions |> ignore + + [] + member _.Cleanup() = ClearAllILModuleReaderCache() + +/// End-to-end compile of a small console app (FSharpChecker.Compile, in-process fsc: resolve + read the +/// framework references, type-check, optimize, write the exe). This is the realistic "build a console app" +/// workload — the reference reading it drives is exactly where lazy ILPreNamespace applies. MemoryDiagnoser +/// reports allocation/op; each iteration starts with a cleared IL reader cache so references are read cold. +[] +[] +type ConsoleAppCompileBenchmarks() = + + let mutable checker = Unchecked.defaultof + let mutable argv = Array.empty + + [] + member _.Setup() = + checker <- FSharpChecker.Create() + argv <- buildConsoleAppArgv checker [] + + [] + member _.CompileConsoleApp() = + let diagnostics, exnOpt = checker.Compile(argv) |> Async.RunSynchronously + match exnOpt with + | Some e -> raise e + | None -> + let errors = diagnostics |> Array.filter (fun d -> d.Severity = FSharpDiagnosticSeverity.Error) + if errors.Length > 0 then failwithf "compile had errors: %A" errors + + [] + member _.Cleanup() = ClearAllILModuleReaderCache() + +/// Per-phase breakdown of the console-app compile via the compiler's own `--times` flag. Shows *where* +/// the compile spends its time (parse / import references / typecheck / optimize / ilwrite), which is +/// what pinpoints the effect of lazy ILPreNamespace (the "import" phase). +/// +/// Not a BDN benchmark: run it from Program.fs with the `times` argument, in each repo, and compare. +module TimesProbe = + + let run () = + let checker = FSharpChecker.Create() + // Warm up JIT + reference resolution so the timed runs aren't dominated by first-call costs. + checker.Compile(buildConsoleAppArgv checker []) |> Async.RunSynchronously |> ignore + + for i in 1..3 do + ClearAllILModuleReaderCache() + printfn "===== compile %d (--times) =====" i + let argv = buildConsoleAppArgv checker [ "--times" ] + let _, exnOpt = checker.Compile(argv) |> Async.RunSynchronously + exnOpt |> Option.iter raise + +/// Compile a real, large project (e.g. Rider's FSharp.Common: ~486 references, ~58 sources) from a +/// captured fsc response file, measuring allocation + time + retained heap per cold compile. This is the +/// realistic "many large references, import a subset of namespaces" workload where lazy ILPreNamespace +/// should matter most. MemoryDiagnoser can't take a runtime file, so this is a standalone probe. +/// +/// Run from Program.fs: `compile-project `. The project dir becomes the +/// working directory so the response file's relative paths (obj/..., resources) resolve. Compare the +/// printed allocation / retained numbers across `main` and this branch. +module CompileProjectProbe = + + let private forceGC () = + GC.Collect(2, GCCollectionMode.Forced, blocking = true) + GC.WaitForPendingFinalizers() + GC.Collect(2, GCCollectionMode.Forced, blocking = true) + + let run (responseFile: string) (projectDir: string) = + Environment.CurrentDirectory <- projectDir + let argv = + File.ReadAllLines responseFile + |> Array.filter (fun l -> l.Trim().Length > 0) + let checker = FSharpChecker.Create() + + let compile () = + let diagnostics, exnOpt = checker.Compile(argv) |> Async.RunSynchronously + exnOpt |> Option.iter raise + diagnostics |> Array.filter (fun d -> d.Severity = FSharpDiagnosticSeverity.Error) |> Array.length + + printfn "Compiling %d args (%d refs); warming up..." + argv.Length (argv |> Array.filter (fun a -> a.StartsWith "-r:") |> Array.length) + let errs = compile () + printfn "warm-up done (%d errors)" errs + + for i in 1..3 do + ClearAllILModuleReaderCache() + forceGC () + let before = GC.GetTotalAllocatedBytes true + let sw = System.Diagnostics.Stopwatch.StartNew() + let errs = compile () + sw.Stop() + let allocated = GC.GetTotalAllocatedBytes true - before + printfn "run %d: %6.0f ms | allocated %8.1f MB | %d errors" + i sw.Elapsed.TotalMilliseconds (float allocated / 1024.0 / 1024.0) errs + + // Retained memory held specifically by the IL module reader cache: the pre-type-def / namespace + // trees for every referenced assembly. This is what a long-lived process (Rider) keeps alive, and + // exactly what lazy ILPreNamespace shrinks (un-imported namespaces are never realised or retained). + // Isolate it as the heap drop when the cache is cleared, so it excludes JIT / checker / GC noise. + let mb (b: int64) = float b / 1024.0 / 1024.0 + for i in 1..3 do + ClearAllILModuleReaderCache() + forceGC () + let baseHeap = GC.GetTotalMemory true + compile () |> ignore + forceGC () + let withCache = GC.GetTotalMemory true + ClearAllILModuleReaderCache() + forceGC () + let afterClear = GC.GetTotalMemory true + printfn "retain %d: reader-cache holds %7.1f MB | total post-compile %7.1f MB (base %6.1f, withCache %6.1f, afterClear %6.1f)" + i (mb (withCache - afterClear)) (mb (withCache - baseHeap)) (mb baseHeap) (mb withCache) (mb afterClear) + +/// Deterministic retained-memory measurement for a real project: run ParseAndCheckProject and keep the +/// results alive, so the imported referenced-assembly structures (CCUs, and the realised pre-type-def / +/// namespace trees they hold) stay on the heap. This mirrors an IDE holding a project's analysis live, +/// which is where lazy ILPreNamespace reduces the retained footprint. Reuses the compile response file. +/// +/// Run from Program.fs: `retain-project `. +module RetainProjectProbe = + + let private forceGC () = + GC.Collect(2, GCCollectionMode.Forced, blocking = true) + GC.WaitForPendingFinalizers() + GC.Collect(2, GCCollectionMode.Forced, blocking = true) + + let run (responseFile: string) (projectDir: string) = + Environment.CurrentDirectory <- projectDir + let lines = + File.ReadAllLines responseFile + |> Array.filter (fun l -> l.Trim().Length > 0) + // Source files are .fs/.fsi paths that aren't flags (e.g. not --embed:...AssemblyInfo.fs), kept in + // response-file order: signature files must precede their implementations. + let sources = + lines + |> Array.filter (fun l -> (l.EndsWith ".fs" || l.EndsWith ".fsi") && not (l.StartsWith "-")) + let otherOptions = + lines |> Array.filter (fun l -> + l <> "fsc.dll" && not (l.StartsWith "-o:") && not (Array.contains l sources)) + + let options: FSharpProjectOptions = + { ProjectFileName = Path.Combine(projectDir, "FSharp.Common.fsproj") + ProjectId = None + SourceFiles = sources + OtherOptions = otherOptions + ReferencedProjects = [||] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = false + LoadTime = System.DateTime(2020, 1, 1) + UnresolvedReferences = None + OriginalLoadReferences = [] + Stamp = None } + + let mb (b: int64) = float b / 1024.0 / 1024.0 + printfn "ParseAndCheckProject: %d sources, %d refs" + sources.Length (otherOptions |> Array.filter (fun o -> o.StartsWith "-r:") |> Array.length) + + // Single measurement per process: FSharpChecker keeps global/static caches alive, so running + // multiple samples in one process contaminates the baseline. Invoke this command repeatedly instead. + ClearAllILModuleReaderCache() + let checker = FSharpChecker.Create(projectCacheSize = 0) + forceGC () + let baseHeap = GC.GetTotalMemory true + let results = checker.ParseAndCheckProject(options) |> Async.RunSynchronously + let errs = results.Diagnostics |> Array.filter (fun d -> d.Severity = FSharpDiagnosticSeverity.Error) |> Array.length + forceGC () + let held = GC.GetTotalMemory true + // Keep the analysis (and thus the imported assembly structures) alive across the measurement. + GC.KeepAlive results + GC.KeepAlive checker + printfn "analysis holds %7.1f MB (base %6.1f -> held %6.1f) | %d errors" + (mb (held - baseHeap)) (mb baseHeap) (mb held) errs + +/// Single-file check in a real project context (the IDE hot path: open one file), then hold the analysis +/// alive so an external heap dump (dotnet-gcdump) can attribute retained memory per type — showing the +/// actual ILPreNamespace / ILPreTypeDef / InterruptibleLazy footprint. Reuses the compile response file. +/// +/// Run from Program.fs: `check-file `. Prints its PID and +/// then sleeps, holding the checker + results rooted, so `dotnet-gcdump collect -p ` can run. +module CheckFileProbe = + + let private forceGC () = + GC.Collect(2, GCCollectionMode.Forced, blocking = true) + GC.WaitForPendingFinalizers() + GC.Collect(2, GCCollectionMode.Forced, blocking = true) + + let run (responseFile: string) (projectDir: string) (fileToCheck: string) = + Environment.CurrentDirectory <- projectDir + let lines = File.ReadAllLines responseFile |> Array.filter (fun l -> l.Trim().Length > 0) + let sources = lines |> Array.filter (fun l -> l.EndsWith ".fs" && not (l.StartsWith "-")) + let otherOptions = + lines |> Array.filter (fun l -> + l <> "fsc.dll" && not (l.StartsWith "-o:") && not (Array.contains l sources)) + + let options: FSharpProjectOptions = + { ProjectFileName = Path.Combine(projectDir, "FSharp.Common.fsproj") + ProjectId = None + SourceFiles = sources + OtherOptions = otherOptions + ReferencedProjects = [||] + IsIncompleteTypeCheckEnvironment = false + UseScriptResolutionRules = false + LoadTime = System.DateTime(2020, 1, 1) + OriginalLoadReferences = [] + UnresolvedReferences = None + Stamp = None } + + // A checker that keeps the incremental builder (and thus the imported referenced assemblies) alive. + let checker = FSharpChecker.Create(projectCacheSize = 1) + ClearAllILModuleReaderCache() + let source = SourceText.ofString (File.ReadAllText fileToCheck) + let _, answer = checker.ParseAndCheckFileInProject(fileToCheck, 0, source, options) |> Async.RunSynchronously + let errs = + match answer with + | FSharpCheckFileAnswer.Aborted -> failwith "check aborted" + | FSharpCheckFileAnswer.Succeeded r -> + r.Diagnostics |> Array.filter (fun d -> d.Severity = FSharpDiagnosticSeverity.Error) |> Array.length + + forceGC () + let held = GC.GetTotalMemory true + let pid = System.Diagnostics.Process.GetCurrentProcess().Id + printfn "checked %s (%d errors)" (Path.GetFileName fileToCheck) errs + printfn "PID %d retained %.1f MB" pid (float held / 1024.0 / 1024.0) + printfn "READY_FOR_DUMP" + Console.Out.Flush() + + // Hold everything rooted while the external dump is collected. + System.Threading.Thread.Sleep(180000) + GC.KeepAlive answer + GC.KeepAlive checker + +/// Retained (live-heap) memory after a cold type-check, with the results kept alive. BenchmarkDotNet's +/// MemoryDiagnoser measures allocation *during* an op, not what survives; the deferred namespace tree's +/// win is that un-opened namespaces are never *retained*, so we measure that separately here. +/// +/// Not a BDN benchmark: run it from Program.fs with the `retained-memory` argument. Compare the printed +/// numbers across `main` and this branch (and narrow-vs-wide within a branch). +module RetainedMemoryProbe = + + let private forceGC () = + GC.Collect(2, GCCollectionMode.Forced, blocking = true) + GC.WaitForPendingFinalizers() + GC.Collect(2, GCCollectionMode.Forced, blocking = true) + + let private measureOne label fileName source = + ClearAllILModuleReaderCache() + let setupChecker = FSharpChecker.Create() + let options = getScriptOptions setupChecker fileName source + + // Empty cache, fresh checker: baseline before any assembly namespaces are read. + ClearAllILModuleReaderCache() + let checker = FSharpChecker.Create(projectCacheSize = 200) + forceGC () + let before = GC.GetTotalMemory(true) + let allocatedBefore = GC.GetTotalAllocatedBytes true + + let answer = check checker fileName source options + + let allocated = GC.GetTotalAllocatedBytes true - allocatedBefore + forceGC () + let after = GC.GetTotalMemory(true) + // Keep everything the check produced alive across the measurement, else the delta is meaningless. + GC.KeepAlive answer + GC.KeepAlive checker + printfn "%-8s retained: %10.2f KB allocated: %10.2f KB (before %10.2f KB, after %10.2f KB)" + label (float (after - before) / 1024.0) (float allocated / 1024.0) (float before / 1024.0) (float after / 1024.0) + + /// Reads every reference assembly the framework offers and forces the whole type-def tree (every type, + /// its nested types, and every namespace level). Isolates the IL reader's per-type and per-namespace + /// object cost from anything the type-checker does with it. + let private measureReadAll () = + // The running framework's implementation assemblies: unlike reference assemblies these hold real + // type bodies (System.Private.CoreLib alone has tens of thousands of types and nested types). + let refs = + Directory.GetFiles(System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory(), "*.dll") + + let readerOptions = + { pdbDirPath = None + reduceMemoryUsage = ReduceMemoryFlag.Yes + metadataOnly = MetadataOnlyFlag.Yes + tryGetMetadataSnapshot = fun _ -> None } + + ClearAllILModuleReaderCache() + forceGC () + let before = GC.GetTotalMemory true + let allocatedBefore = GC.GetTotalAllocatedBytes true + + let readers = ResizeArray() + let mutable typeCount = 0 + + let rec forceTypeDefs (tdefs: FSharp.Compiler.AbstractIL.IL.ILTypeDefs) = + for tdef in tdefs do + typeCount <- typeCount + 1 + forceTypeDefs tdef.NestedTypes + + for r in refs do + let reader = OpenILModuleReader r readerOptions + readers.Add reader + forceTypeDefs reader.ILModuleDef.TypeDefs + + let allocated = GC.GetTotalAllocatedBytes true - allocatedBefore + forceGC () + let after = GC.GetTotalMemory true + GC.KeepAlive readers + printfn "%-8s retained: %10.2f KB allocated: %10.2f KB (%d assemblies, %d type defs)" + "ReadAll" (float (after - before) / 1024.0) (float allocated / 1024.0) refs.Length typeCount + + /// Type-checks a small file and then forces the *import* of every entity of every referenced assembly + /// (what walking an assembly's contents in an IDE does). Isolates the cost of turning IL type defs and + /// namespace levels into TAST entities, which the narrow/wide checks barely touch. + let private measureImportAll () = + let fileName = "importall.fsx" + let setupChecker = FSharpChecker.Create() + let options = getScriptOptions setupChecker fileName narrowSource + + ClearAllILModuleReaderCache() + let checker = FSharpChecker.Create(projectCacheSize = 200) + forceGC () + let before = GC.GetTotalMemory true + let allocatedBefore = GC.GetTotalAllocatedBytes true + + let answer = check checker fileName narrowSource options + + let results = + match answer with + | FSharpCheckFileAnswer.Succeeded results -> results + | FSharpCheckFileAnswer.Aborted -> failwith "check aborted" + + let mutable entityCount = 0 + + let rec walk (entity: FSharp.Compiler.Symbols.FSharpEntity) = + entityCount <- entityCount + 1 + for nested in entity.NestedEntities do + walk nested + + for asm in results.ProjectContext.GetReferencedAssemblies() do + for entity in asm.Contents.Entities do + walk entity + + let allocated = GC.GetTotalAllocatedBytes true - allocatedBefore + forceGC () + let after = GC.GetTotalMemory true + GC.KeepAlive answer + GC.KeepAlive checker + printfn "%-8s retained: %10.2f KB allocated: %10.2f KB (%d entities)" + "ImportAll" (float (after - before) / 1024.0) (float allocated / 1024.0) entityCount + + let run () = + printfn "Retained-memory probe (lower is better; compare across branches):" + measureOne "Narrow" "narrow.fsx" narrowSource + measureOne "Wide" "wide.fsx" wideSource + measureReadAll () + measureImportAll () diff --git a/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/Program.fs b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/Program.fs index c0883da14e9..d89d5da8f6d 100644 --- a/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/Program.fs +++ b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/Program.fs @@ -4,6 +4,28 @@ open BenchmarkDotNet.Configs [] let main args = - let cfg = ManualConfig.Create(DefaultConfig.Instance).WithOptions(ConfigOptions.DisableOptimizationsValidator) - BenchmarkSwitcher.FromAssembly(typeof.Assembly).Run(args,cfg) |> ignore - 0 + match args with + // Standalone retained-memory probe (not a BDN benchmark); see RetainedMemoryProbe for why. + | [| "retained-memory" |] -> + RetainedMemoryProbe.run () + 0 + // Per-phase compile breakdown via the compiler's --times flag; see TimesProbe. + | [| "times" |] -> + TimesProbe.run () + 0 + // Compile a real project from a captured fsc response file; see CompileProjectProbe. + | [| "compile-project"; responseFile; projectDir |] -> + CompileProjectProbe.run responseFile projectDir + 0 + // Deterministic retained memory of a real project's analysis held live; see RetainProjectProbe. + | [| "retain-project"; responseFile; projectDir |] -> + RetainProjectProbe.run responseFile projectDir + 0 + // Single-file check then hold alive for an external heap dump; see CheckFileProbe. + | [| "check-file"; responseFile; projectDir; fileToCheck |] -> + CheckFileProbe.run responseFile projectDir fileToCheck + 0 + | _ -> + let cfg = ManualConfig.Create(DefaultConfig.Instance).WithOptions(ConfigOptions.DisableOptimizationsValidator) + BenchmarkSwitcher.FromAssembly(typeof.Assembly).Run(args,cfg) |> ignore + 0 diff --git a/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/README.md b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/README.md index 1b574ec1b56..15e2d57422d 100644 --- a/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/README.md +++ b/tests/benchmarks/FCSBenchmarks/CompilerServiceBenchmarks/README.md @@ -13,6 +13,26 @@ Running all benchmarks: Running a specific benchmark: ```dotnet run -c Release --filter *ParsingCheckExpressionsFs*``` +## Namespace-import benchmarks (lazy ILPreNamespace) + +`NamespaceImportBenchmarks.fs` measures the effect of lazy namespace reading in the IL reader: a project +that references large **non-F#** assemblies (the BCL) but opens only a few namespaces should read and +retain less. F# assemblies are unpickled and do not exercise this path. + +Startup time + transient allocation (BDN, `MemoryDiagnoser`): +```dotnet run -c Release --filter *NamespaceImportStartup*``` +`NarrowImport` opens one namespace (where laziness should pay off); `WideImport` opens many (control — +should stay flat). Compare the `Mean` and `Allocated` columns across `main` and this branch. + +Retained (live-heap) memory — MemoryDiagnoser only sees allocation *during* an op, not what survives, so +this is a separate standalone probe: +```dotnet run -c Release -- retained-memory``` +It prints retained KB for Narrow and Wide. The win is un-opened namespaces never being *retained*, so +compare `Narrow` retained across `main` and this branch (and Narrow-vs-Wide within a branch). + +To compare branches: build + run on `main`, note the numbers, `git checkout il-pre-namespace`, rebuild +and re-run, diff. (The `BenchmarkComparison/` project automates historical before/after runs if preferred.) + ## Sample results | Method | Job | UnrollFactor | Mean | Error | StdDev | Median | Gen 0 | Gen 1 | Gen 2 | Allocated |