Serialization and deserialization of the typechecking data

Author: psfinaki

src/Compiler/AbstractIL/il.fs

@@ -2781,6 +2781,8 @@ type ILTypeDef
 
     member _.MetadataIndex = metadataIndex
 
+    member _.Flags = additionalFlags
+
     member x.With
         (
             ?name,

src/Compiler/AbstractIL/il.fsi

@@ -949,6 +949,8 @@ type internal ILSecurityDecl = ILSecurityDecl of ILSecurityAction * byte[]
 /// below to construct/destruct these.
 [<NoComparison; NoEquality; Struct>]
 type internal ILSecurityDecls =
+    new: array: ILSecurityDecl[] -> ILSecurityDecls
+
     member AsList: unit -> ILSecurityDecl list
 
 /// Represents the efficiency-oriented storage of ILSecurityDecls in another item.
@@ -1207,6 +1209,8 @@ type ILMethodDef =
 /// name and arity.
 [<NoEquality; NoComparison; Class; Sealed>]
 type ILMethodDefs =
+    new: f: (unit -> ILMethodDef array) -> ILMethodDefs
+
     inherit DelayInitArrayMap<ILMethodDef, string, ILMethodDef list>
 
     interface IEnumerable<ILMethodDef>
@@ -1311,6 +1315,7 @@ type ILFieldDef =
 /// a form to allow efficient looking up fields by name.
 [<NoEquality; NoComparison; Sealed>]
 type ILFieldDefs =
+
     member internal AsList: unit -> ILFieldDef list
 
     member internal LookupByName: string -> ILFieldDef list
@@ -1613,6 +1618,7 @@ type ILTypeDef =
     member Encoding: ILDefaultPInvokeEncoding
     member IsKnownToBeAttribute: bool
     member CanContainExtensionMethods: bool
+    member Flags: ILTypeDefAdditionalFlags
 
     member internal WithAccess: ILTypeDefAccess -> ILTypeDef
     member internal WithNestedAccess: ILMemberAccess -> ILTypeDef

src/Compiler/Driver/CompilerImports.fs

@@ -337,6 +337,54 @@ let EncodeOptimizationData (tcGlobals, tcConfig: TcConfig, outfile, exportRemapp
     else
         []
 
+let GetTypecheckingData (file, ilScopeRef, ilModule, byteReaderA, byteReaderB) =
+
+    let memA = byteReaderA ()
+
+    let memB =
+        match byteReaderB with
+        | None -> ByteMemory.Empty.AsReadOnly()
+        | Some br -> br ()
+
+    unpickleObjWithDanglingCcus file ilScopeRef ilModule unpickleTcInfo memA memB
+
+let WriteTypecheckingData (tcConfig: TcConfig, tcGlobals, fileName, inMem, ccu, tcInfo) =
+
+    // need to understand the naming and if we even want two resources here...
+    let rName = "FSharpTypecheckingData"
+    let rNameB = "FSharpTypecheckingDataB"
+
+    PickleToResource
+        inMem
+        fileName
+        tcGlobals
+        tcConfig.compressMetadata
+        ccu
+        (rName + ccu.AssemblyName)
+        (rNameB + ccu.AssemblyName)
+        pickleTcInfo
+        tcInfo
+
+let EncodeTypecheckingData (tcConfig: TcConfig, tcGlobals, generatedCcu, outfile, isIncrementalBuild, tcInfo) =
+    let r1, r2 =
+        WriteTypecheckingData(
+            tcConfig, 
+            tcGlobals,
+            outfile, 
+            isIncrementalBuild, 
+            generatedCcu,
+            tcInfo)
+
+    let resources =
+        [
+            r1
+            match r2 with
+            | None -> ()
+            | Some r -> r
+        ]
+
+    resources
+
 exception AssemblyNotResolved of originalName: string * range: range
 
 exception MSBuildReferenceResolutionWarning of message: string * warningCode: string * range: range

src/Compiler/Driver/CompilerImports.fsi

@@ -19,6 +19,7 @@ open FSharp.Compiler.TcGlobals
 open FSharp.Compiler.BuildGraph
 open FSharp.Compiler.IO
 open FSharp.Compiler.Text
+open FSharp.Compiler.TypedTreePickle
 open FSharp.Core.CompilerServices
 
 #if !NO_TYPEPROVIDERS
@@ -71,6 +72,23 @@ val EncodeOptimizationData:
     isIncrementalBuild: bool ->
         ILResource list
 
+val GetTypecheckingData:
+    file: string *
+    ilScopeRef: ILScopeRef *
+    ilModule: ILModuleDef option *
+    byteReaderA: (unit -> ReadOnlyByteMemory) *
+    byteReaderB: (unit -> ReadOnlyByteMemory) option ->
+        PickledDataWithReferences<PickledTcInfo>
+
+val EncodeTypecheckingData:
+    tcConfig: TcConfig *
+    tcGlobals: TcGlobals *
+    generatedCcu: CcuThunk *
+    outfile: string *
+    isIncrementalBuild: bool *
+    tcInfo: PickledTcInfo ->
+        ILResource list
+
 [<RequireQualifiedAccess>]
 type ResolveAssemblyReferenceMode =
     | Speculative

src/Compiler/Driver/ReuseTcResults/CachingDriver.fs

@@ -3,12 +3,17 @@ module internal FSharp.Compiler.ReuseTcResults
 open System.Collections.Generic
 open System.IO
 
+open FSharp.Compiler.CheckDeclarations
 open FSharp.Compiler.CompilerConfig
 open FSharp.Compiler.Diagnostics
 open FSharp.Compiler.GraphChecking
 open FSharp.Compiler.IO
+open FSharp.Compiler.ParseAndCheckInputs
 open FSharp.Compiler.Syntax
 open FSharp.Compiler.Syntax.PrettyNaming
+open FSharp.Compiler.TypedTree
+open CompilerImports
+open FSharp.Compiler.AbstractIL.IL
 
 type TcData =
     {
@@ -139,3 +144,60 @@ type CachingDriver(tcConfig: TcConfig) =
             use _ = Activity.start Activity.Events.reuseTcResultsCacheAbsent []
             writeThisTcData thisTcData
             false
+
+    member _.ReuseTcResults inputs (tcInitialState: TcState) =
+
+        let bytes = File.ReadAllBytes("tc")
+        let memory = ByteMemory.FromArray(bytes)
+        let byteReaderA () = ReadOnlyByteMemory(memory)
+
+        let byteReaderB = None
+
+        let tcInfo =
+            GetTypecheckingData(
+                "", // assembly.FileName,
+                ILScopeRef.Local, // assembly.ILScopeRef,
+                None, //assembly.RawMetadata.TryGetILModuleDef(),
+                byteReaderA,
+                byteReaderB
+            )
+
+        let rawData = tcInfo.RawData
+
+        let topAttrs: TopAttribs =
+            {
+                mainMethodAttrs = rawData.MainMethodAttrs
+                netModuleAttrs = rawData.NetModuleAttrs
+                assemblyAttrs = rawData.AssemblyAttrs
+            }
+
+        // need to understand if anything can be used here, pickling state is hard
+        tcInitialState,
+        topAttrs,
+        rawData.DeclaredImpls,
+        // this is quite definitely wrong, need to figure out what to do with the environment
+        tcInitialState.TcEnvFromImpls
+
+    member _.CacheTcResults(tcState: TcState, topAttrs: TopAttribs, declaredImpls, tcEnvAtEndOfLastFile, inputs, tcGlobals, outfile) =
+        let thisTcData =
+            {
+                CmdLine = getThisCompilationCmdLine tcConfig.cmdLineArgs
+                Graph = getThisCompilationGraph inputs
+                References = getThisCompilationReferences tcConfig.referencedDLLs
+            }
+
+        writeThisTcData thisTcData
+
+        let tcInfo =
+            {
+                MainMethodAttrs = topAttrs.mainMethodAttrs
+                NetModuleAttrs = topAttrs.netModuleAttrs
+                AssemblyAttrs = topAttrs.assemblyAttrs
+                DeclaredImpls = declaredImpls
+            }
+
+        let encodedData =
+            EncodeTypecheckingData(tcConfig, tcGlobals, tcState.Ccu, outfile, false, tcInfo)
+
+        let resource = encodedData[0].GetBytes().ToArray()
+        File.WriteAllBytes("tc", resource)

src/Compiler/Driver/fsc.fs

@@ -150,7 +150,8 @@ let TypeCheck
         tcEnv0,
         openDecls0,
         inputs,
-        exiter: Exiter
+        exiter: Exiter,
+        outfile
     ) =
     try
         if isNil inputs then
@@ -167,20 +168,35 @@ let TypeCheck
             let cachingDriver = CachingDriver(tcConfig)
 
             if cachingDriver.CanReuseTcResults(inputs) then
-                // do nothing, yet
-                ()
+                cachingDriver.ReuseTcResults inputs tcInitialState
+            else
+                let tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile =
+                    CheckClosedInputSet(
+                        ctok,
+                        diagnosticsLogger.CheckForErrors,
+                        tcConfig,
+                        tcImports,
+                        tcGlobals,
+                        None,
+                        tcInitialState,
+                        eagerFormat,
+                        inputs
+                    )
 
-        CheckClosedInputSet(
-            ctok,
-            (fun () -> diagnosticsLogger.CheckForRealErrorsIgnoringWarnings),
-            tcConfig,
-            tcImports,
-            tcGlobals,
-            None,
-            tcInitialState,
-            eagerFormat,
-            inputs
-        )
+                cachingDriver.CacheTcResults(tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile, inputs, tcGlobals, outfile)
+                tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile
+        else
+            CheckClosedInputSet(
+                ctok,
+                (fun () -> diagnosticsLogger.CheckForRealErrorsIgnoringWarnings),
+                tcConfig,
+                tcImports,
+                tcGlobals,
+                None,
+                tcInitialState,
+                eagerFormat,
+                inputs
+            )
     with exn ->
         errorRecovery exn rangeStartup
         exiter.Exit 1
@@ -481,6 +497,8 @@ let main1
         disposables: DisposablesTracker
     ) =
 
+    CompilerGlobalState.stampCount <- 0L
+
     // See Bug 735819
     let lcidFromCodePage =
         let thread = Thread.CurrentThread
@@ -701,7 +719,7 @@ let main1
     let inputs = inputs |> List.map fst
 
     let tcState, topAttrs, typedAssembly, _tcEnvAtEnd =
-        TypeCheck(ctok, tcConfig, tcImports, tcGlobals, diagnosticsLogger, assemblyName, tcEnv0, openDecls0, inputs, exiter)
+        TypeCheck(ctok, tcConfig, tcImports, tcGlobals, diagnosticsLogger, assemblyName, tcEnv0, openDecls0, inputs, exiter, outfile)
 
     AbortOnError(diagnosticsLogger, exiter)
     ReportTime tcConfig "Typechecked"

src/Compiler/TypedTree/CompilerGlobalState.fs

@@ -72,7 +72,7 @@ let newUnique() = System.Threading.Interlocked.Increment &uniqueCount
 
 /// Unique name generator for stamps attached to to val_specs, tycon_specs etc.
 //++GLOBAL MUTABLE STATE (concurrency-safe)
-let mutable private stampCount = 0L
+let mutable stampCount = 0L
 let newStamp() =
     let stamp = System.Threading.Interlocked.Increment &stampCount
     stamp

src/Compiler/TypedTree/CompilerGlobalState.fsi

@@ -47,6 +47,8 @@ type Unique = int64
 /// Concurrency-safe
 val newUnique: (unit -> int64)
 
+val mutable stampCount: int64
+
 /// Unique name generator for stamps attached to to val_specs, tycon_specs etc.
 /// Concurrency-safe
 val newStamp: (unit -> int64)

src/Compiler/TypedTree/TypedTree.fs

@@ -252,6 +252,8 @@ type ValFlags(flags: int64) =
         // Clear the IsGeneratedEventVal, since there's no use in propagating specialname information for generated add/remove event vals
                                                       (flags       &&&   ~~~0b010011001100000000000L) 
 
+    member x.Flags = flags
+
 /// Represents the kind of a type parameter
 [<RequireQualifiedAccess (* ; StructuredFormatDisplay("{DebugText}") *) >]
 type TyparKind = 
@@ -490,6 +492,7 @@ type EntityFlags(flags: int64) =
     /// Get the flags as included in the F# binary metadata
     member x.PickledBits =                         (flags       &&&  ~~~0b000111111000100L)
 
+    member x.Flags = flags
 
 
 exception UndefinedName of 
@@ -5918,6 +5921,12 @@ type PickledCcuInfo =
 
     override _.ToString() = "PickledCcuInfo(...)"
 
+type PickledTcInfo = {
+    MainMethodAttrs: Attribs
+    NetModuleAttrs: Attribs
+    AssemblyAttrs: Attribs
+    DeclaredImpls: CheckedImplFile list
+}
 
 /// Represents a set of free local values. Computed and cached by later phases
 /// (never cached type checking). Cached in expressions. Not pickled.

src/Compiler/TypedTree/TypedTree.fsi

@@ -162,6 +162,8 @@ type ValFlags =
 
     member WithMakesNoCriticalTailcalls: ValFlags
 
+    member Flags: int64
+
 /// Represents the kind of a type parameter
 [<RequireQualifiedAccess>]
 type TyparKind =
@@ -292,6 +294,8 @@ type EntityFlags =
     /// Get the flags as included in the F# binary metadata
     member PickledBits: int64
 
+    member Flags: int64
+
     member PreEstablishedHasDefaultConstructor: bool
 
     /// These two bits represents the on-demand analysis about whether the entity is assumed to be a readonly struct
@@ -4297,6 +4301,12 @@ type PickledCcuInfo =
     [<DebuggerBrowsable(DebuggerBrowsableState.Never)>]
     member DebugText: string
 
+type PickledTcInfo =
+    { MainMethodAttrs: Attribs
+      NetModuleAttrs: Attribs
+      AssemblyAttrs: Attribs
+      DeclaredImpls: CheckedImplFile list }
+
 /// Represents a set of free local values. Computed type cached by later phases
 /// (never cached type checking). Cached in expressions. Not pickled.
 type FreeLocals = Zset<Val>