[WIP] Added strong cache for ILModuleReaders

src/ProvidedTypes.fs

@@ -1848,6 +1848,7 @@ namespace ProviderImplementation.ProvidedTypes.AssemblyReader
     open System
     open System.Collections.Generic
     open System.Collections.Concurrent
+    open System.Collections.ObjectModel
     open System.IO
     open System.Reflection
     open System.Text
@@ -6621,13 +6622,8 @@ namespace ProviderImplementation.ProvidedTypes.AssemblyReader
             with err -> 
               failwithf  "FAILED decodeILCustomAttribData, data.Length = %d, data = %A, meth = %A, argtypes = %A, fixedArgs=%A, nnamed = %A, sigptr before named = %A,  innerError = %A" bytes.Length bytes ca.Method.EnclosingType ca.Method.FormalArgTypes fixedArgs nnamed sigptr (err.ToString())
 
-        type CacheValue = ILModuleReader * DateTime
-        let (|CacheValue|_|) (wr: WeakReference) = match wr.Target with null -> None | v -> Some (v :?> CacheValue)
-        let CacheValue (reader: CacheValue) = System.WeakReference reader
-
-        // Amortize readers weakly - this is enough that all the type providers in this DLL will at least share
-        // resources when all instantiated at the same time.
-        let readersWeakCache = ConcurrentDictionary<(string * string), WeakReference>()
+        // Share DLLs across providers by caching them
+        let readerCache = ConcurrentDictionary<(string * string), DateTime * int * ILModuleReader>()
 
         type File with 
             static member ReadBinaryChunk (fileName: string, start, len) = 
@@ -6639,22 +6635,32 @@ namespace ProviderImplementation.ProvidedTypes.AssemblyReader
                     n <- n + stream.Read(buffer, n, len-n)
                 buffer
 
-        let ILModuleReaderAfterReadingAllBytes  (fileName:string, ilGlobals: ILGlobals) =
-            let timeStamp = File.GetLastWriteTimeUtc(fileName)
-            let key = (fileName, ilGlobals.systemRuntimeScopeRef.QualifiedName)
-            match readersWeakCache.TryGetValue (key) with
-            | true, CacheValue (mr2, timeStamp2) when timeStamp = timeStamp2 ->
-                mr2 // throw away the bytes we just read and recycle the existing ILModuleReader
-            | _ ->
-                let bytes = File.ReadAllBytes fileName
-                let is = ByteFile(bytes)
-                let pe = PEReader(fileName, is)
-                let mdchunk = File.ReadBinaryChunk (fileName, pe.MetadataPhysLoc, pe.MetadataSize)
-                let mdfile = ByteFile(mdchunk)
-                let mr = ILModuleReader(fileName, mdfile, ilGlobals, true)
-                readersWeakCache.[key] <- CacheValue (mr, timeStamp)
-                mr
-
+        let createReader ilGlobals (fileName: string) =
+            let bytes = File.ReadAllBytes fileName
+            let is = ByteFile(bytes)
+            let pe = PEReader(fileName, is)
+            let mdchunk = File.ReadBinaryChunk (fileName, pe.MetadataPhysLoc, pe.MetadataSize)
+            let mdfile = ByteFile(mdchunk)
+            let reader = ILModuleReader(fileName, mdfile, ilGlobals, true)
+            reader
+
+        let GetReaderCache () = ReadOnlyDictionary(readerCache)
+
+        let ILModuleReaderAfterReadingAllBytes (file:string, ilGlobals: ILGlobals) =
+            let key = (file, ilGlobals.systemRuntimeScopeRef.QualifiedName)
+            let add _ = 
+                let lastWriteTime = File.GetLastWriteTime(file)
+                let reader = createReader ilGlobals file
+                (lastWriteTime, 1, reader)
+            let update _ (currentLastWriteTime, count, reader) =
+                let lastWriteTime = File.GetLastWriteTime(file)
+                if currentLastWriteTime <> lastWriteTime then
+                    let reader = createReader ilGlobals file
+                    (lastWriteTime, count + 1, reader)
+                else
+                    (lastWriteTime, count, reader)
+            let _, _, reader = readerCache.AddOrUpdate(key, add, update)
+            reader
 
         (* NOTE: ecma_ prefix refers to the standard "mscorlib" *)
         let EcmaPublicKey = PublicKeyToken ([|0xdeuy; 0xaduy; 0xbeuy; 0xefuy; 0xcauy; 0xfeuy; 0xfauy; 0xceuy |])

src/ProvidedTypes.fsi

@@ -8,6 +8,21 @@
 //
 // This code has been modified and is appropriate for use in conjunction with the F# 3.0-4.0 releases
 
+#if INTERNAL_FSHARP_TYPEPROVIDERS_SDK_TESTS
+
+namespace ProviderImplementation.ProvidedTypes.AssemblyReader
+
+open System
+open System.Collections.ObjectModel
+
+[<AutoOpen>]
+module internal Reader =
+
+    type ILModuleReader = class end
+
+    val GetReaderCache : unit -> ReadOnlyDictionary<(string * string), DateTime * int * ILModuleReader>
+
+#endif
 
 namespace ProviderImplementation.ProvidedTypes
 

tests/BasicErasedProvisionTests.fs

@@ -543,6 +543,42 @@ let ``test basic symbol type ops``() =
    t2T.GetConstructors() |> ignore
    t2T.GetMethod("get_Item1") |> ignore
 
+#if INTERNAL_FSHARP_TYPEPROVIDERS_SDK_TESTS
+
+[<Fact>]
+let ``test reader cache actually caches``() =
+    for i = 1 to 1000 do
+        let refs = Targets.DotNet45FSharp40Refs()
+        let config = Testing.MakeSimulatedTypeProviderConfig (resolutionFolder=__SOURCE_DIRECTORY__, runtimeAssembly="whatever.dll", runtimeAssemblyRefs=refs)
+        use tp = new TypeProviderForNamespaces(config)
+        let ctxt = tp.TargetContext
+
+        //let fscore =  ctxt1.TryBindAssemblyNameToTarget(AssemblyName("FSharp.Core")) 
+        let decimalT = typeof<decimal>
+        let kg = ProvidedMeasureBuilder.SI "kg"
+        let t1 = ProvidedMeasureBuilder.AnnotateType(decimalT, [ kg ])
+
+        match kg with :? ProvidedTypeSymbol as st -> Assert.True(st.IsFSharpTypeAbbreviation) | _ -> failwith "expected a ProvidedTypeSymbol"
+        match t1 with :? ProvidedTypeSymbol as st -> Assert.True(st.IsFSharpUnitAnnotated) | _ -> failwith "expected a ProvidedTypeSymbol#2"
+
+        let t1T = ctxt.ConvertSourceTypeToTarget t1
+        let kgT = ctxt.ConvertSourceTypeToTarget kg
+        match kgT with :? ProvidedTypeSymbol as st -> Assert.True(st.IsFSharpTypeAbbreviation) | _ -> failwith "expected a ProvidedTypeSymbol#3"
+        match t1T with :? ProvidedTypeSymbol as st -> Assert.True(st.IsFSharpUnitAnnotated) | _ -> failwith "expected a ProvidedTypeSymbol#4"
+
+        let _ = ProvidedTypeBuilder.MakeTupleType([ t1; t1 ])
+        ()
+
+    let dict = AssemblyReader.Reader.GetReaderCache()
+    Assert.True(dict.Count > 0, "Reader Cache has not count")
+    dict
+    |> Seq.iter (fun pair ->
+        let _, count, _ = pair.Value
+        Assert.False(count > 500, "Too many instances of an assembly")
+    )
+
+#endif
+
 [<TypeProvider>]
 type public SampleTypeProvider(config : TypeProviderConfig) as this = 
     inherit TypeProviderForNamespaces(config)

tests/FSharp.TypeProviders.SDK.Tests.fsproj

@@ -4,6 +4,12 @@
      <TargetFrameworks>netcoreapp2.0;net461</TargetFrameworks>
      <IsPackable>false</IsPackable>
   </PropertyGroup>
+  <PropertyGroup Condition="'$(Configuration)|$(TargetFramework)|$(Platform)'=='Release|netcoreapp2.0|AnyCPU'">
+    <DefineConstants>TRACE;INTERNAL_FSHARP_TYPEPROVIDERS_SDK_TESTS</DefineConstants>
+  </PropertyGroup>
+  <PropertyGroup Condition="'$(Configuration)|$(TargetFramework)|$(Platform)'=='Debug|netcoreapp2.0|AnyCPU'">
+    <DefineConstants>TRACE;INTERNAL_FSHARP_TYPEPROVIDERS_SDK_TESTS</DefineConstants>
+  </PropertyGroup>
   <ItemGroup>
     <None Include="xunit.runner.json">
       <CopyToOutputDirectory>PreserveNewest</CopyToOutputDirectory>