diff --git a/src/Compiler/AbstractIL/il.fs b/src/Compiler/AbstractIL/il.fs index 33a46ff0a23..2b80afae54c 100644 --- a/src/Compiler/AbstractIL/il.fs +++ b/src/Compiler/AbstractIL/il.fs @@ -2781,6 +2781,8 @@ type ILTypeDef member _.MetadataIndex = metadataIndex + member _.Flags = additionalFlags + member x.With ( ?name, diff --git a/src/Compiler/AbstractIL/il.fsi b/src/Compiler/AbstractIL/il.fsi index f80c64b0c59..3485ea3d091 100644 --- a/src/Compiler/AbstractIL/il.fsi +++ b/src/Compiler/AbstractIL/il.fsi @@ -949,6 +949,8 @@ type internal ILSecurityDecl = ILSecurityDecl of ILSecurityAction * byte[] /// below to construct/destruct these. [] 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. [] type ILMethodDefs = + new: f: (unit -> ILMethodDef array) -> ILMethodDefs + inherit DelayInitArrayMap interface IEnumerable @@ -1311,6 +1315,7 @@ type ILFieldDef = /// a form to allow efficient looking up fields by name. [] 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 diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs index cf875be4959..1e06e938a04 100644 --- a/src/Compiler/Driver/CompilerConfig.fs +++ b/src/Compiler/Driver/CompilerConfig.fs @@ -445,6 +445,11 @@ type TypeCheckingMode = | Sequential | Graph +[] +type ReuseTcResults = + | On + | Off + [] type TypeCheckingConfig = { @@ -652,6 +657,8 @@ type TcConfigBuilder = mutable parallelReferenceResolution: ParallelReferenceResolution + mutable reuseTcResults: ReuseTcResults + mutable captureIdentifiersWhenParsing: bool mutable typeCheckingConfig: TypeCheckingConfig @@ -661,6 +668,8 @@ type TcConfigBuilder = mutable realsig: bool mutable compilationMode: TcGlobals.CompilationMode + + mutable cmdLineArgs: string array } // Directories to start probing in @@ -859,6 +868,7 @@ type TcConfigBuilder = xmlDocInfoLoader = None exiter = QuitProcessExiter parallelReferenceResolution = ParallelReferenceResolution.Off + reuseTcResults = ReuseTcResults.Off captureIdentifiersWhenParsing = false typeCheckingConfig = { @@ -873,6 +883,7 @@ type TcConfigBuilder = realsig = false strictIndentation = None compilationMode = TcGlobals.CompilationMode.Unset + cmdLineArgs = [||] } member tcConfigB.FxResolver = @@ -1413,11 +1424,13 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.xmlDocInfoLoader = data.xmlDocInfoLoader member _.exiter = data.exiter member _.parallelReferenceResolution = data.parallelReferenceResolution + member _.reuseTcResults = data.reuseTcResults member _.captureIdentifiersWhenParsing = data.captureIdentifiersWhenParsing member _.typeCheckingConfig = data.typeCheckingConfig member _.dumpSignatureData = data.dumpSignatureData member _.realsig = data.realsig member _.compilationMode = data.compilationMode + member _.cmdLineArgs = data.cmdLineArgs static member Create(builder, validate) = use _ = UseBuildPhase BuildPhase.Parameter diff --git a/src/Compiler/Driver/CompilerConfig.fsi b/src/Compiler/Driver/CompilerConfig.fsi index 0e6c25727f8..57814db287d 100644 --- a/src/Compiler/Driver/CompilerConfig.fsi +++ b/src/Compiler/Driver/CompilerConfig.fsi @@ -208,6 +208,11 @@ type ParallelReferenceResolution = | On | Off +[] +type ReuseTcResults = + | On + | Off + /// Determines the algorithm used for type-checking. [] type TypeCheckingMode = @@ -519,6 +524,8 @@ type TcConfigBuilder = mutable parallelReferenceResolution: ParallelReferenceResolution + mutable reuseTcResults: ReuseTcResults + mutable captureIdentifiersWhenParsing: bool mutable typeCheckingConfig: TypeCheckingConfig @@ -528,6 +535,8 @@ type TcConfigBuilder = mutable realsig: bool mutable compilationMode: TcGlobals.CompilationMode + + mutable cmdLineArgs: string array } static member CreateNew: @@ -899,6 +908,8 @@ type TcConfig = member parallelReferenceResolution: ParallelReferenceResolution + member reuseTcResults: ReuseTcResults + member captureIdentifiersWhenParsing: bool member typeCheckingConfig: TypeCheckingConfig @@ -909,6 +920,8 @@ type TcConfig = member compilationMode: TcGlobals.CompilationMode + member cmdLineArgs: string array + /// Represents a computation to return a TcConfig. Normally this is just a constant immutable TcConfig, /// but for F# Interactive it may be based on an underlying mutable TcConfigBuilder. [] diff --git a/src/Compiler/Driver/CompilerImports.fsi b/src/Compiler/Driver/CompilerImports.fsi index 2a95347ecbf..3efa43d1236 100644 --- a/src/Compiler/Driver/CompilerImports.fsi +++ b/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 @@ -52,6 +53,19 @@ val IsReflectedDefinitionsResource: ILResource -> bool val GetResourceNameAndSignatureDataFuncs: ILResource list -> (string * ((unit -> ReadOnlyByteMemory) * (unit -> ReadOnlyByteMemory) option)) list +/// Pickling primitive +val PickleToResource: + inMem: bool -> + file: string -> + g: TcGlobals -> + compress: bool -> + scope: CcuThunk -> + rName: string -> + rNameB: string -> + p: ('a -> WriterState -> unit) -> + x: 'a -> + ILResource * ILResource option + /// Encode the F# interface data into a set of IL attributes and resources val EncodeSignatureData: tcConfig: TcConfig * diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs index 7c4c81efd40..ab0afa1e457 100644 --- a/src/Compiler/Driver/CompilerOptions.fs +++ b/src/Compiler/Driver/CompilerOptions.fs @@ -1388,6 +1388,14 @@ let advancedFlagsFsc tcConfigB = None, Some(FSComp.SR.optsEmitDebugInfoInQuotations (formatOptionSwitch tcConfigB.emitDebugInfoInQuotations)) ) + + CompilerOption( + "reusetypecheckingresults", + tagNone, + OptionUnit(fun () -> tcConfigB.reuseTcResults <- ReuseTcResults.On), + None, + Some(FSComp.SR.optsReuseTcResults ()) + ) ] // OptionBlock: Internal options (test use only) diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index 975bfeef66f..ad1a74f8df5 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1478,8 +1478,19 @@ let CheckClosedInputSetFinish (declaredImpls: CheckedImplFile list, tcState) = tcState, declaredImpls, ccuContents let CheckMultipleInputsSequential (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) = - (tcState, inputs) - ||> List.mapFold (CheckOneInputEntry(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) + let checkOneInputEntry = + CheckOneInputEntry(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) + + let mutable state = tcState + + let results = + inputs + |> List.map (fun input -> + let result, newState = checkOneInputEntry state input + state <- newState // Update state for the next iteration + result, newState) + + results |> List.map fst, state, results |> List.map snd open FSharp.Compiler.GraphChecking @@ -1833,7 +1844,7 @@ let CheckMultipleInputsUsingGraphMode TcState * (PhasedDiagnostic -> PhasedDiagnostic) * ParsedInput list) - : FinalFileResult list * TcState = + : FinalFileResult list * TcState * TcState list = use cts = new CancellationTokenSource() let sourceFiles: FileInProject array = @@ -1931,40 +1942,44 @@ let CheckMultipleInputsUsingGraphMode partialResult, state) ) - UseMultipleDiagnosticLoggers (inputs, diagnosticsLogger, Some eagerFormat) (fun inputsWithLoggers -> - // Equip loggers to locally filter w.r.t. scope pragmas in each input - let inputsWithLoggers = - inputsWithLoggers - |> List.toArray - |> Array.map (fun (input, oldLogger) -> - let logger = DiagnosticsLoggerForInput(tcConfig, input, oldLogger) - input, logger) - - let processFile (node: NodeToTypeCheck) (state: State) : Finisher = - match node with - | NodeToTypeCheck.ArtificialImplFile idx -> - let parsedInput, _ = inputsWithLoggers[idx] - processArtificialImplFile node parsedInput state - | NodeToTypeCheck.PhysicalFile idx -> - let parsedInput, logger = inputsWithLoggers[idx] - processFile node (parsedInput, logger) state - - let state: State = tcState, priorErrors - - let partialResults, (tcState, _) = - TypeCheckingGraphProcessing.processTypeCheckingGraph nodeGraph processFile state cts.Token - - let partialResults = - partialResults - // Bring back the original, index-based file order. - |> List.sortBy fst - |> List.map snd - - partialResults, tcState) + let results, state = + UseMultipleDiagnosticLoggers (inputs, diagnosticsLogger, Some eagerFormat) (fun inputsWithLoggers -> + // Equip loggers to locally filter w.r.t. scope pragmas in each input + let inputsWithLoggers = + inputsWithLoggers + |> List.toArray + |> Array.map (fun (input, oldLogger) -> + let logger = DiagnosticsLoggerForInput(tcConfig, input, oldLogger) + input, logger) + + let processFile (node: NodeToTypeCheck) (state: State) : Finisher = + match node with + | NodeToTypeCheck.ArtificialImplFile idx -> + let parsedInput, _ = inputsWithLoggers[idx] + processArtificialImplFile node parsedInput state + | NodeToTypeCheck.PhysicalFile idx -> + let parsedInput, logger = inputsWithLoggers[idx] + processFile node (parsedInput, logger) state + + let state: State = tcState, priorErrors + + let partialResults, (tcState, _) = + TypeCheckingGraphProcessing.processTypeCheckingGraph nodeGraph processFile state cts.Token + + let partialResults = + partialResults + // Bring back the original, index-based file order. + |> List.sortBy fst + |> List.map snd + + partialResults, tcState) + + // TODO: collect states here also + results, state, [] let CheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat, inputs) = // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions - let results, tcState = + let results, lastState, tcStates = match tcConfig.typeCheckingConfig.Mode with | TypeCheckingMode.Graph when (not tcConfig.isInteractive && not tcConfig.compilingFSharpCore) -> CheckMultipleInputsUsingGraphMode( @@ -1981,10 +1996,11 @@ let CheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tc | _ -> CheckMultipleInputsSequential(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _), tcState = - CheckMultipleInputsFinish(results, tcState) + CheckMultipleInputsFinish(results, lastState) let tcState, declaredImpls, ccuContents = CheckClosedInputSetFinish(implFiles, tcState) tcState.Ccu.Deref.Contents <- ccuContents - tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile + + tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile, tcStates diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index fb32a4557cd..f00fac9b229 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -3,7 +3,9 @@ /// Contains logic to coordinate the parsing and checking of one or a group of files module internal FSharp.Compiler.ParseAndCheckInputs +open System.Collections.Generic open System.IO +open Internal.Utilities.Collections open Internal.Utilities.Library open FSharp.Compiler.CheckBasics open FSharp.Compiler.CheckDeclarations @@ -143,9 +145,23 @@ val ParseInputFiles: /// applying the InternalsVisibleTo in referenced assemblies and opening 'Checked' if requested. val GetInitialTcEnv: assemblyName: string * range * TcConfig * TcImports * TcGlobals -> TcEnv * OpenDeclaration list +type RootSigs = Zmap + +type RootImpls = Zset + +val qnameOrder: IComparer + /// Represents the incremental type checking state for a set of inputs -[] type TcState = + { tcsCcu: CcuThunk + tcsTcSigEnv: TcEnv + tcsTcImplEnv: TcEnv + tcsCreatesGeneratedProvidedTypes: bool + tcsRootSigs: RootSigs + tcsRootImpls: RootImpls + tcsCcuSig: ModuleOrNamespaceType + tcsImplicitOpenDeclarations: OpenDeclaration list } + /// The CcuThunk for the current assembly being checked member Ccu: CcuThunk @@ -239,7 +255,7 @@ val CheckClosedInputSet: tcState: TcState * eagerFormat: (PhasedDiagnostic -> PhasedDiagnostic) * inputs: ParsedInput list -> - TcState * TopAttribs * CheckedImplFile list * TcEnv + TcState * TopAttribs * CheckedImplFile list * TcEnv * TcState list /// Check a single input and finish the checking val CheckOneInputAndFinish: diff --git a/src/Compiler/Driver/ReuseTcResults/CachingDriver.fs b/src/Compiler/Driver/ReuseTcResults/CachingDriver.fs new file mode 100644 index 00000000000..e6baf3aff8d --- /dev/null +++ b/src/Compiler/Driver/ReuseTcResults/CachingDriver.fs @@ -0,0 +1,355 @@ +module internal FSharp.Compiler.ReuseTcResults.CachingDriver + +#nowarn "3261" + +open System.IO + +open FSharp.Compiler.AbstractIL.IL +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.ReuseTcResults.TcResultsImport +open FSharp.Compiler.ReuseTcResults.TcResultsPickle +open FSharp.Compiler.TypedTree + +type TcCompilationData = + { + CmdLine: string array + References: string array + } + +type GraphFileLine = + { + Index: int + FileName: string + Stamp: int64 + } + +type Graph = + { + Files: GraphFileLine list + Dependencies: string list + } + +type GraphComparisonResult = (ParsedInput * bool) list + +[] +type TcCacheState = + | Empty + | Present of GraphComparisonResult + +type TcResult = + { + Input: ParsedInput + DeclaredImpl: CheckedImplFile + State: TcState + } + +[] +type CachingDriver(tcConfig: TcConfig) = + + let outputDir = tcConfig.outputDir |> Option.defaultValue "" + let tcDataFilePath = Path.Combine(outputDir, "tcComplilationData") + let graphFilePath = Path.Combine(outputDir, "tcGraph") + let tcSharedDataFilePath = Path.Combine(outputDir, "tcSharedData") + let tcInputFilePath = Path.Combine(outputDir, "tcInput") + let tcStateFilePath = Path.Combine(outputDir, "tcState") + + [] + let CmdLineHeader = "CMDLINE" + + [] + let ReferencesHeader = "REFERENCES" + + let writeThisTcData tcData = + use tcDataFile = FileSystem.OpenFileForWriteShim tcDataFilePath + + let lines = ResizeArray() + lines.Add $"BEGIN {CmdLineHeader}" + lines.AddRange tcData.CmdLine + lines.Add $"BEGIN {ReferencesHeader}" + lines.AddRange tcData.References + + tcDataFile.WriteAllLines lines + + let readPrevTcData () = + if FileSystem.FileExistsShim tcDataFilePath then + use tcDataFile = FileSystem.OpenFileForReadShim tcDataFilePath + + let cmdLine = ResizeArray() + let refs = ResizeArray() + + let mutable currentHeader = "" + + tcDataFile.ReadLines() + |> Seq.iter (fun line -> + match line with + | line when line.StartsWith "BEGIN" -> currentHeader <- line.Split ' ' |> Array.last + | line -> + match currentHeader with + | CmdLineHeader -> cmdLine.Add line + | ReferencesHeader -> refs.Add line + | _ -> invalidOp "broken tc cache") + + Some + { + CmdLine = cmdLine.ToArray() + References = refs.ToArray() + } + + else + None + + let writeThisGraph graph = + use tcDataFile = FileSystem.OpenFileForWriteShim graphFilePath + + let formatGraphFileLine l = + sprintf "%i,%s,%i" l.Index l.FileName l.Stamp + + (graph.Files |> List.map formatGraphFileLine) @ graph.Dependencies + |> tcDataFile.WriteAllLines + + let readPrevGraph () = + if FileSystem.FileExistsShim graphFilePath then + use graphFile = FileSystem.OpenFileForReadShim graphFilePath + + let parseGraphFileLine (l: string) = + let parts = l.Split(',') |> Array.toList + + { + Index = int parts[0] + FileName = parts[1] + Stamp = int64 parts[2] + } + + let depLines, fileLines = + graphFile.ReadAllLines() + |> Array.toList + |> List.partition (fun l -> l.Contains "-->") + + Some + { + Files = fileLines |> List.map parseGraphFileLine + Dependencies = depLines + } + else + None + + let formatAssemblyReference (r: AssemblyReference) = + let fileName = r.Text + let lastWriteTime = FileSystem.GetLastWriteTimeShim fileName + sprintf "%s,%i" fileName lastWriteTime.Ticks + + let getThisCompilationCmdLine args = args + + // maybe split into two things? + let getThisCompilationGraph inputs = + let sourceFiles = + inputs + |> Seq.toArray + |> Array.mapi (fun idx (input: ParsedInput) -> + { + Idx = idx + FileName = input.FileName + ParsedInput = input + }) + + let filePairs = FilePairMap sourceFiles + let graph, _ = DependencyResolution.mkGraph filePairs sourceFiles + + let graphFileLines = + [ + for KeyValue(idx, _) in graph do + let fileName = sourceFiles[idx].FileName + let lastWriteTime = FileSystem.GetLastWriteTimeShim fileName + + let graphFileLine = + { + Index = idx + FileName = fileName + Stamp = lastWriteTime.Ticks + } + + yield graphFileLine + ] + + let dependencies = + [ + for KeyValue(idx, deps) in graph do + for depIdx in deps do + yield $"%i{idx} --> %i{depIdx}" + ] + + { + Files = graphFileLines + Dependencies = dependencies + } + + let getThisCompilationReferences = Seq.map formatAssemblyReference >> Seq.toArray + + // TODO: don't ignore dependencies + let compareGraphs (inputs: ParsedInput list) thisGraph baseGraph : GraphComparisonResult = + + let isPresentInBaseGraph thisLine = + baseGraph.Files + |> Seq.tryFind (fun baseLine -> baseLine.FileName = thisLine.FileName) + |> Option.exists (fun baseLine -> baseLine.Stamp = thisLine.Stamp) + + // TODO: make this robust + let findMatchingInput thisLine = + inputs + |> Seq.where (fun input -> input.FileName = thisLine.FileName) + |> Seq.exactlyOne + + thisGraph.Files + |> List.map (fun thisLine -> + let input = findMatchingInput thisLine + let canReuse = isPresentInBaseGraph thisLine + input, canReuse) + + member _.GetTcCacheState inputs = + let prevTcDataOpt = readPrevTcData () + + let thisTcData = + { + CmdLine = getThisCompilationCmdLine tcConfig.cmdLineArgs + References = getThisCompilationReferences tcConfig.referencedDLLs + } + + match prevTcDataOpt with + | Some prevTcData -> + use _ = Activity.start Activity.Events.reuseTcResultsCachePresent [] + + if prevTcData = thisTcData then + match readPrevGraph () with + | Some graph -> + let thisGraph = getThisCompilationGraph inputs + + let graphComparisonResult = graph |> compareGraphs inputs thisGraph + + // we'll need more events do distinguish scenarios here + use _ = + if graphComparisonResult |> Seq.forall (fun (_file, canUse) -> canUse) then + Activity.start Activity.Events.reuseTcResultsCacheHit [] + else + Activity.start Activity.Events.reuseTcResultsCacheMissed [] + + TcCacheState.Present graphComparisonResult + | None -> + use _ = Activity.start Activity.Events.reuseTcResultsCacheMissed [] + TcCacheState.Empty + else + use _ = Activity.start Activity.Events.reuseTcResultsCacheMissed [] + TcCacheState.Empty + + | None -> + use _ = Activity.start Activity.Events.reuseTcResultsCacheAbsent [] + TcCacheState.Empty + + member private _.ReuseSharedData() = + let bytes = File.ReadAllBytes(tcSharedDataFilePath) + let memory = ByteMemory.FromArray(bytes) + let byteReaderA () = ReadOnlyByteMemory(memory) + + let data = + GetSharedData( + "", // assembly.FileName, + ILScopeRef.Local, // assembly.ILScopeRef, + None, //assembly.RawMetadata.TryGetILModuleDef(), + byteReaderA, + None + ) + + data.RawData + + member private _.ReuseDeclaredImpl(implFile: ParsedInput) = + let fileName = Path.GetFileNameWithoutExtension(implFile.FileName) + let bytes = File.ReadAllBytes($"{tcInputFilePath}{fileName}") + let memory = ByteMemory.FromArray(bytes) + let byteReaderA () = ReadOnlyByteMemory(memory) + + let data = + GetCheckedImplFile( + "", // assembly.FileName, + ILScopeRef.Local, // assembly.ILScopeRef, + None, //assembly.RawMetadata.TryGetILModuleDef(), + byteReaderA, + None + ) + + data.RawData + + member private _.ReuseTcState(name: string) : TcState = + let bytes = File.ReadAllBytes($"{tcStateFilePath}{name}") + let memory = ByteMemory.FromArray(bytes) + let byteReaderA () = ReadOnlyByteMemory(memory) + + let data = + GetTypecheckingDataTcState( + "", // assembly.FileName, + ILScopeRef.Local, // assembly.ILScopeRef, + None, //assembly.RawMetadata.TryGetILModuleDef(), + byteReaderA, + None + ) + + data.RawData + + member this.ReuseTcResults inputs = + let sharedData = this.ReuseSharedData() + let declaredImpls = inputs |> List.map this.ReuseDeclaredImpl + + let lastInput = inputs |> List.last + let fileName = Path.GetFileNameWithoutExtension(lastInput.FileName) + let lastState = this.ReuseTcState fileName + + lastState, sharedData.TopAttribs, declaredImpls, lastState.TcEnvFromImpls + + member private _.CacheSharedData(tcState: TcState, sharedData, tcGlobals, outfile) = + let encodedData = + EncodeSharedData(tcConfig, tcGlobals, tcState.Ccu, outfile, false, sharedData) + + let resource = encodedData[0].GetBytes().ToArray() + File.WriteAllBytes(tcSharedDataFilePath, resource) + + member private _.CacheDeclaredImpl(fileName: string, tcState: TcState, impl, tcGlobals, outfile) = + let encodedData = + EncodeCheckedImplFile(tcConfig, tcGlobals, tcState.Ccu, outfile, false, impl) + + let resource = encodedData[0].GetBytes().ToArray() + File.WriteAllBytes($"{tcInputFilePath}{fileName}", resource) + + member private _.CacheTcState(fileName: string, tcState: TcState, tcGlobals, outfile) = + let encodedData = + EncodeTypecheckingDataTcState(tcConfig, tcGlobals, tcState.Ccu, outfile, false, tcState) + + let resource = encodedData[0].GetBytes().ToArray() + File.WriteAllBytes($"{tcStateFilePath}{fileName}", resource) + + member this.CacheTcResults(tcResults, topAttribs, _tcEnvAtEndOfLastFile, tcGlobals, outfile) = + let thisTcData = + { + CmdLine = getThisCompilationCmdLine tcConfig.cmdLineArgs + References = getThisCompilationReferences tcConfig.referencedDLLs + } + + writeThisTcData thisTcData + + let inputs = tcResults |> List.map (fun r -> r.Input) + let thisGraph = getThisCompilationGraph inputs + writeThisGraph thisGraph + + let sharedData = { TopAttribs = topAttribs } + + let lastState = tcResults |> List.map (fun r -> r.State) |> List.last + this.CacheSharedData(lastState, sharedData, tcGlobals, outfile) + + tcResults + |> List.iter (fun r -> + // TODO: bare file name is not enough + let fileName = Path.GetFileNameWithoutExtension(r.Input.FileName) + this.CacheDeclaredImpl(fileName, r.State, r.DeclaredImpl, tcGlobals, outfile) + this.CacheTcState(fileName, r.State, tcGlobals, outfile)) diff --git a/src/Compiler/Driver/ReuseTcResults/TcResultsImport.fs b/src/Compiler/Driver/ReuseTcResults/TcResultsImport.fs new file mode 100644 index 00000000000..a0fb35e0a82 --- /dev/null +++ b/src/Compiler/Driver/ReuseTcResults/TcResultsImport.fs @@ -0,0 +1,133 @@ +module internal FSharp.Compiler.ReuseTcResults.TcResultsImport + +open FSharp.Compiler.CompilerConfig +open FSharp.Compiler.IO +open FSharp.Compiler.CompilerImports +open FSharp.Compiler.TypedTreePickle +open FSharp.Compiler.ReuseTcResults.TcResultsPickle + +let GetSharedData (file, ilScopeRef, ilModule, byteReaderA, byteReaderB) = + + let memA = byteReaderA () + + let memB = + match byteReaderB with + | None -> ByteMemory.Empty.AsReadOnly() + | Some br -> br () + + unpickleObjWithDanglingCcus file ilScopeRef ilModule unpickleSharedData memA memB + +let GetCheckedImplFile (file, ilScopeRef, ilModule, byteReaderA, byteReaderB) = + + let memA = byteReaderA () + + let memB = + match byteReaderB with + | None -> ByteMemory.Empty.AsReadOnly() + | Some br -> br () + + unpickleObjWithDanglingCcus file ilScopeRef ilModule unpickleCheckedImplFile memA memB + +let GetTypecheckingDataTcState (file, ilScopeRef, ilModule, byteReaderA, byteReaderB) = + + let memA = byteReaderA () + + let memB = + match byteReaderB with + | None -> ByteMemory.Empty.AsReadOnly() + | Some br -> br () + + unpickleObjWithDanglingCcus file ilScopeRef ilModule unpickleTcState memA memB + +let WriteSharedData (tcConfig: TcConfig, tcGlobals, fileName, inMem, ccu, sharedData) = + + // 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) + pickleSharedData + sharedData + +let WriteCheckedImplFile (tcConfig: TcConfig, tcGlobals, fileName, inMem, ccu, checkedImplFile) = + + // 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) + pickleCheckedImplFile + checkedImplFile + +let WriteTypecheckingDataTcState (tcConfig: TcConfig, tcGlobals, fileName, inMem, ccu, tcState) = + + // 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) + pickleTcState + tcState + +let EncodeSharedData (tcConfig: TcConfig, tcGlobals, generatedCcu, outfile, isIncrementalBuild, sharedData) = + let r1, r2 = + WriteSharedData(tcConfig, tcGlobals, outfile, isIncrementalBuild, generatedCcu, sharedData) + + let resources = + [ + r1 + match r2 with + | None -> () + | Some r -> r + ] + + resources + +let EncodeCheckedImplFile (tcConfig: TcConfig, tcGlobals, generatedCcu, outfile, isIncrementalBuild, checkedImplFile) = + let r1, r2 = + WriteCheckedImplFile(tcConfig, tcGlobals, outfile, isIncrementalBuild, generatedCcu, checkedImplFile) + + let resources = + [ + r1 + match r2 with + | None -> () + | Some r -> r + ] + + resources + +let EncodeTypecheckingDataTcState (tcConfig: TcConfig, tcGlobals, generatedCcu, outfile, isIncrementalBuild, tcState) = + let r1, r2 = + WriteTypecheckingDataTcState(tcConfig, tcGlobals, outfile, isIncrementalBuild, generatedCcu, tcState) + + let resources = + [ + r1 + match r2 with + | None -> () + | Some r -> r + ] + + resources diff --git a/src/Compiler/Driver/ReuseTcResults/TcResultsPickle.fs b/src/Compiler/Driver/ReuseTcResults/TcResultsPickle.fs new file mode 100644 index 00000000000..e61c96c9d74 --- /dev/null +++ b/src/Compiler/Driver/ReuseTcResults/TcResultsPickle.fs @@ -0,0 +1,1810 @@ +module internal FSharp.Compiler.ReuseTcResults.TcResultsPickle + +open FSharp.Compiler +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AccessibilityLogic +open FSharp.Compiler.CheckBasics +open FSharp.Compiler.CheckDeclarations +open FSharp.Compiler.CompilerGlobalState +open FSharp.Compiler.ConstraintSolver +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.NameResolution +open FSharp.Compiler.ParseAndCheckInputs +open FSharp.Compiler.Infos +open FSharp.Compiler.Syntax +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.Text.Range +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeBasics +open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypedTreePickle +open FSharp.Compiler.Xml + +open Internal.Utilities +open Internal.Utilities.Collections +open Internal.Utilities.Library +open Internal.Utilities.Library.Extras + +type TcSharedData = { TopAttribs: TopAttribs } + +// pickling + +let p_stamp = p_int64 + +let p_stamp_map pv = p_Map p_stamp pv + +let p_non_null_slot f (x: 'a | null) st = + match x with + | null -> p_byte 0 st + | h -> + p_byte 1 st + f h st + +let p_ILTypeDefAdditionalFlags (x: ILTypeDefAdditionalFlags) st = p_int32 (int x) st + +let p_ILTypeDef (x: ILTypeDef) st = + p_string x.Name st + //p_type_attributes x.Attributes + //p_il_type_def_layout x.Layout + //x.Implements + //x.Extends + //x.Methods + //x.NestedTypes + //x.Fields + //x.MethodImpls + //x.Events + //x.Properties + p_ILTypeDefAdditionalFlags x.Flags st +//x.SecurityDeclsStored +//x.CustomAttrsStored +//p_il +//p_int32 x.MetadataIndex st + +let p_tyar_spec_data_new (x: Typar) st = + p_tup6 + p_ident + p_attribs + p_int64 + p_tyar_constraints + p_xmldoc + p_stamp + (x.typar_id, x.Attribs, int64 x.typar_flags.PickledBits, x.Constraints, x.XmlDoc, x.Stamp) + st + +let p_tyar_spec_new (x: Typar) st = + //Disabled, workaround for bug 2721: if x.Rigidity <> TyparRigidity.Rigid then warning(Error(sprintf "p_tyar_spec: typar#%d is not rigid" x.Stamp, x.Range)) + if x.IsFromError then + warning (Error((0, "p_tyar_spec: from error"), x.Range)) + + p_osgn_decl st.otypars p_tyar_spec_data_new x st + +let p_tyar_specs_new = (p_list p_tyar_spec_new) + +let rec p_ty_new (ty: TType) st : unit = + match ty with + | TType_tuple(tupInfo, l) -> + p_byte 0 st + p_tup2 p_tup_info p_tys_new (tupInfo, l) st + + | TType_app(tyconRef, typeInstantiation, nullness) -> + p_byte 1 st + + p_tup4 + (p_tcref "app") + p_tys_new + p_nullness + (p_non_null_slot p_entity_spec_new) + (tyconRef, typeInstantiation, nullness, tyconRef.binding) + st + + | TType_fun(domainType, rangeType, nullness) -> + p_byte 2 st + p_ty_new domainType st + p_ty_new rangeType st + p_nullness nullness st + + | TType_var(typar, nullness) -> + p_byte 3 st + p_tup4 p_tpref p_nullness (p_option p_ty_new) p_stamp (typar, nullness, typar.Solution, typar.Stamp) st + + | TType_forall(tps, r) -> + p_byte 4 st + p_tup2 p_typars p_ty_new (tps, r) st + + | TType_measure unt -> + p_byte 5 st + p_measure_expr unt st + + | TType_ucase(uc, tinst) -> + p_byte 6 st + p_tup2 p_ucref p_tys_new (uc, tinst) st + + | TType_anon(anonInfo, l) -> + p_byte 7 st + p_tup2 p_anonInfo p_tys_new (anonInfo, l) st + +and p_tys_new l = + let _count = l.Length + p_list p_ty_new l + +and p_expr_new (expr: Expr) st = + match expr with + | Expr.Link e -> + p_byte 0 st + p_expr_new e.Value st + | Expr.Const(x, m, ty) -> + p_byte 1 st + p_tup3 p_const p_dummy_range p_ty_new (x, m, ty) st + | Expr.Val(a, b, m) -> + p_byte 2 st + p_tup4 p_vref_new p_vrefFlags p_dummy_range (p_non_null_slot p_Val_new) (a, b, m, a.binding) st + | Expr.Op(a, b, c, d) -> + p_byte 3 st + p_tup4 p_op_new p_tys_new p_exprs_new p_dummy_range (a, b, c, d) st + | Expr.Sequential(a, b, c, d) -> + p_byte 4 st + + p_tup4 + p_expr_new + p_expr_new + p_int + p_dummy_range + (a, + b, + (match c with + | NormalSeq -> 0 + | ThenDoSeq -> 1), + d) + st + | Expr.Lambda(_, a1, b0, b1, c, d, e) -> + p_byte 5 st + p_tup6 (p_option p_Val) (p_option p_Val) p_Vals p_expr_new p_dummy_range p_ty_new (a1, b0, b1, c, d, e) st + | Expr.TyLambda(_, b, c, d, e) -> + p_byte 6 st + p_tup4 p_tyar_specs_new p_expr_new p_dummy_range p_ty_new (b, c, d, e) st + | Expr.App(funcExpr, formalType, typeArgs, args, range) -> + p_byte 7 st + + p_expr_new funcExpr st + p_ty_new formalType st + p_tys_new typeArgs st + p_exprs_new args st + p_dummy_range range st + | Expr.LetRec(a, b, c, _) -> + p_byte 8 st + p_tup3 p_binds p_expr_new p_dummy_range (a, b, c) st + | Expr.Let(a, b, c, _) -> + p_byte 9 st + p_tup3 p_bind p_expr_new p_dummy_range (a, b, c) st + | Expr.Match(_, a, b, c, d, e) -> + p_byte 10 st + p_tup5 p_dummy_range p_dtree p_targets p_dummy_range p_ty_new (a, b, c, d, e) st + | Expr.Obj(_, b, c, d, e, f, g) -> + p_byte 11 st + p_tup6 p_ty_new (p_option p_Val) p_expr_new p_methods p_intfs p_dummy_range (b, c, d, e, f, g) st + | Expr.StaticOptimization(a, b, c, d) -> + p_byte 12 st + p_tup4 p_constraints p_expr_new p_expr_new p_dummy_range (a, b, c, d) st + | Expr.TyChoose(a, b, c) -> + p_byte 13 st + p_tup3 p_tyar_specs_new p_expr_new p_dummy_range (a, b, c) st + | Expr.Quote(ast, _, _, m, ty) -> + p_byte 14 st + p_tup3 p_expr_new p_dummy_range p_ty_new (ast, m, ty) st + | Expr.WitnessArg(traitInfo, m) -> + p_byte 15 st + p_trait traitInfo st + p_dummy_range m st + | Expr.DebugPoint(_, innerExpr) -> + p_byte 16 st + p_expr_new innerExpr st + +and p_exprs_new = p_list p_expr_new + +and p_ucref_new (UnionCaseRef(a, b)) st = + p_tup3 (p_tcref "ucref") p_string (p_non_null_slot p_entity_spec_new) (a, b, a.binding) st + +and p_op_new x st = + match x with + | TOp.UnionCase c -> + p_byte 0 st + p_ucref_new c st + | TOp.ExnConstr c -> + p_byte 1 st + p_tcref "op" c st + | TOp.Tuple tupInfo -> + if evalTupInfoIsStruct tupInfo then + p_byte 29 st + else + p_byte 2 st + | TOp.Recd(a, b) -> + p_byte 3 st + p_tup2 p_recdInfo (p_tcref "recd op") (a, b) st + | TOp.ValFieldSet a -> + p_byte 4 st + p_rfref a st + | TOp.ValFieldGet a -> + p_byte 5 st + p_rfref a st + | TOp.UnionCaseTagGet a -> + p_byte 6 st + p_tcref "cnstr op" a st + | TOp.UnionCaseFieldGet(a, b) -> + p_byte 7 st + p_tup2 p_ucref p_int (a, b) st + | TOp.UnionCaseFieldSet(a, b) -> + p_byte 8 st + p_tup2 p_ucref p_int (a, b) st + | TOp.ExnFieldGet(a, b) -> + p_byte 9 st + p_tup2 (p_tcref "exn op") p_int (a, b) st + | TOp.ExnFieldSet(a, b) -> + p_byte 10 st + p_tup2 (p_tcref "exn op") p_int (a, b) st + | TOp.TupleFieldGet(tupInfo, a) -> + if evalTupInfoIsStruct tupInfo then + p_byte 30 st + p_int a st + else + p_byte 11 st + p_int a st + | TOp.ILAsm(a, b) -> + p_byte 12 st + p_tup2 (p_list p_ILInstr) p_tys (a, b) st + | TOp.RefAddrGet _ -> p_byte 13 st + | TOp.UnionCaseProof a -> + p_byte 14 st + p_ucref a st + | TOp.Coerce -> p_byte 15 st + | TOp.TraitCall b -> + p_byte 16 st + p_trait b st + | TOp.LValueOp(a, b) -> + p_byte 17 st + p_tup2 p_lval_op_kind (p_vref "lval") (a, b) st + | TOp.ILCall(a1, a2, a3, a4, a5, a7, a8, a9, b, c, d) -> + p_byte 18 st + + p_tup11 + p_bool + p_bool + p_bool + p_bool + p_vrefFlags + p_bool + p_bool + p_ILMethodRef + p_tys + p_tys + p_tys + (a1, a2, a3, a4, a5, a7, a8, a9, b, c, d) + st + | TOp.Array -> p_byte 19 st + | TOp.While _ -> p_byte 20 st + | TOp.IntegerForLoop(_, _, dir) -> + p_byte 21 st + + p_int + (match dir with + | FSharpForLoopUp -> 0 + | CSharpForLoopUp -> 1 + | FSharpForLoopDown -> 2) + st + | TOp.Bytes bytes -> + p_byte 22 st + p_bytes bytes st + | TOp.TryWith _ -> p_byte 23 st + | TOp.TryFinally _ -> p_byte 24 st + | TOp.ValFieldGetAddr(a, _) -> + p_byte 25 st + p_rfref a st + | TOp.UInt16s arr -> + p_byte 26 st + p_array p_uint16 arr st + | TOp.Reraise -> p_byte 27 st + | TOp.UnionCaseFieldGetAddr(a, b, _) -> + p_byte 28 st + p_tup2 p_ucref p_int (a, b) st + // Note tag byte 29 is taken for struct tuples, see above + // Note tag byte 30 is taken for struct tuples, see above + (* 29: TOp.Tuple when evalTupInfoIsStruct tupInfo = true *) + (* 30: TOp.TupleFieldGet when evalTupInfoIsStruct tupInfo = true *) + | TOp.AnonRecd info -> + p_byte 31 st + p_anonInfo info st + | TOp.AnonRecdGet(info, n) -> + p_byte 32 st + p_anonInfo info st + p_int n st + | TOp.Goto _ + | TOp.Label _ + | TOp.Return -> failwith "unexpected backend construct in pickled TAST" + +and p_entity_spec_data_new (x: Entity) st = + p_tyar_specs_new (x.entity_typars.Force(x.entity_range)) st + p_string x.entity_logical_name st + p_option p_string x.EntityCompiledName st + p_range x.entity_range st + p_stamp x.entity_stamp st + p_option p_pubpath x.entity_pubpath st + p_access x.Accessibility st + p_access x.TypeReprAccessibility st + p_attribs x.entity_attribs st + let _ = p_tycon_repr_new x.entity_tycon_repr st + p_option p_ty_new x.TypeAbbrev st + p_tcaug_new x.entity_tycon_tcaug st + p_string System.String.Empty st + p_kind x.TypeOrMeasureKind st + p_int64 x.entity_flags.Flags st + p_option p_cpath x.entity_cpath st + p_maybe_lazy p_modul_typ_new x.entity_modul_type st + p_exnc_repr x.ExceptionInfo st + + if st.oInMem then + p_used_space1 (p_xmldoc x.XmlDoc) st + else + p_space 1 () st + +and p_entity_spec_new x st = + p_osgn_decl st.oentities p_entity_spec_data_new x st + +and p_ValData_new x st = + p_string x.val_logical_name st + p_option p_string x.ValCompiledName st + // only keep range information on published values, not on optimization data + p_ranges (x.ValReprInfo |> Option.map (fun _ -> x.val_range, x.DefinitionRange)) st + + p_ty_new x.val_type st + p_stamp x.val_stamp st + + p_int64 x.val_flags.Flags st + p_option p_member_info x.MemberInfo st + p_attribs x.Attribs st + p_option p_ValReprInfo x.ValReprInfo st + p_string x.XmlDocSig st + p_access x.Accessibility st + p_parentref x.TryDeclaringEntity st + p_option p_const x.LiteralValue st + + if st.oInMem then + p_used_space1 (p_xmldoc x.XmlDoc) st + else + p_space 1 () st + +and p_Val_new x st = p_osgn_decl st.ovals p_ValData_new x st + +and p_modul_typ_new (x: ModuleOrNamespaceType) st = + p_tup3 p_istype (p_qlist p_Val_new) (p_qlist p_entity_spec_new) (x.ModuleOrNamespaceKind, x.AllValsAndMembers, x.AllEntities) st + +and p_tcaug_new (p: TyconAugmentation) st = + p_tup9 + (p_option (p_tup2 (p_vref "compare_obj") (p_vref "compare"))) + (p_option (p_vref "compare_withc")) + (p_option (p_tup3 (p_vref "hash_obj") (p_vref "hash_withc") (p_vref "equals_withc"))) + (p_option (p_tup2 (p_vref "hash") (p_vref "equals"))) + (p_list (p_tup2 p_string (p_vref "adhoc"))) + (p_list (p_tup3 p_ty_new p_bool p_dummy_range)) + (p_option p_ty_new) + p_bool + (p_space 1) + (p.tcaug_compare, + p.tcaug_compare_withc, + p.tcaug_hash_and_equals_withc + |> Option.map (fun (v1, v2, v3, _) -> (v1, v2, v3)), + p.tcaug_equals, + (p.tcaug_adhoc_list + |> ResizeArray.toList + // Explicit impls of interfaces only get kept in the adhoc list + // in order to get check the well-formedness of an interface. + // Keeping them across assembly boundaries is not valid, because relinking their ValRefs + // does not work correctly (they may get incorrectly relinked to a default member) + |> List.filter (fun (isExplicitImpl, _) -> not isExplicitImpl) + |> List.map (fun (_, vref) -> vref.LogicalName, vref)), + p.tcaug_interfaces, + p.tcaug_super, + p.tcaug_abstract, + space) + st + +and p_ccu_data (x: CcuData) st = + p_option p_string x.FileName st + p_ILScopeRef x.ILScopeRef st + p_stamp x.Stamp st + p_option p_string x.QualifiedName st + p_string x.SourceCodeDirectory st + p_bool x.IsFSharp st +#if !NO_TYPEPROVIDERS + p_bool x.IsProviderGenerated st +#endif + p_bool x.UsesFSharp20PlusQuotations st + p_entity_spec_data_new x.Contents st + +and p_ccuref_new (x: CcuThunk) st = + p_tup2 p_ccu_data p_string (x.target, x.name) st + +and p_nleref_new (x: NonLocalEntityRef) st = + let (NonLocalEntityRef(ccu, strings)) = x + p_tup2 p_ccuref_new (p_array p_string) (ccu, strings) st + +and p_tcref_new (x: EntityRef) st = + match x with + | ERefLocal x -> + p_byte 0 st + p_local_item_ref "tcref" st.oentities x st + | ERefNonLocal x -> + p_byte 1 st + p_nleref_new x st + +and p_nonlocal_val_ref_new (nlv: NonLocalValOrMemberRef) st = + let a = nlv.EnclosingEntity + let key = nlv.ItemKey + let pkey = key.PartialKey + p_tcref_new a st + p_option p_string pkey.MemberParentMangledName st + p_bool pkey.MemberIsOverride st + p_string pkey.LogicalName st + p_int pkey.TotalArgCount st + + let isStructThisArgPos = + match key.TypeForLinkage with + | None -> false + | Some ty -> checkForInRefStructThisArg st ty + + p_option p_ty_new key.TypeForLinkage st + +and p_vref_new (x: ValRef) st = + match x with + | VRefLocal x -> + p_byte 0 st + p_local_item_ref "valref" st.ovals x st + | VRefNonLocal x -> + p_byte 1 st + p_nonlocal_val_ref_new x st + +and p_bind_new (TBind(a, b, _)) st = p_tup2 p_Val_new p_expr_new (a, b) st + +and p_binding (x: ModuleOrNamespaceBinding) st = + match x with + | ModuleOrNamespaceBinding.Binding binding -> + p_byte 0 st + p_bind binding st + | ModuleOrNamespaceBinding.Module(moduleOrNamespace, moduleOrNamespaceContents) -> + p_byte 1 st + p_tup2 p_entity_spec_new p_module_or_namespace_contents (moduleOrNamespace, moduleOrNamespaceContents) st + +and p_tycon_repr_new (x: TyconRepresentation) st = + // The leading "p_byte 1" and "p_byte 0" come from the F# 2.0 format, which used an option value at this point. + + match x with + // Records + | TFSharpTyconRepr { + fsobjmodel_rfields = fs + fsobjmodel_kind = TFSharpRecord + } -> + p_byte 1 st + p_byte 0 st + p_rfield_table fs st + false + + // Unions without static fields + | TFSharpTyconRepr { + fsobjmodel_cases = x + fsobjmodel_kind = TFSharpUnion + fsobjmodel_rfields = fs + } when fs.FieldsByIndex.Length = 0 -> + p_byte 1 st + p_byte 1 st + p_array p_unioncase_spec x.CasesTable.CasesByIndex st + false + + // Unions with static fields, added to format + | TFSharpTyconRepr({ + fsobjmodel_cases = cases + fsobjmodel_kind = TFSharpUnion + } as r) -> + if st.oglobals.compilingFSharpCore then + let fields = r.fsobjmodel_rfields.FieldsByIndex + let firstFieldRange = fields[0].DefinitionRange + + let allFieldsText = + fields + |> Array.map (fun f -> f.LogicalName) + |> String.concat System.Environment.NewLine + + raise (Error(FSComp.SR.pickleFsharpCoreBackwardsCompatible ("fields in union", allFieldsText), firstFieldRange)) + + p_byte 2 st + p_array p_unioncase_spec cases.CasesTable.CasesByIndex st + p_tycon_objmodel_data r st + false + + | TAsmRepr ilTy -> + p_byte 1 st + p_byte 2 st + p_ILType ilTy st + false + + | TFSharpTyconRepr r -> + p_byte 1 st + p_byte 3 st + p_tycon_objmodel_data r st + false + + | TMeasureableRepr ty -> + p_byte 1 st + p_byte 4 st + p_ty ty st + false + + | TNoRepr -> + p_byte 0 st + false + +#if !NO_TYPEPROVIDERS + | TProvidedTypeRepr info -> + if info.IsErased then + // Pickle erased type definitions as a NoRepr + p_byte 0 st + false + else + // Pickle generated type definitions as a TAsmRepr + p_byte 1 st + p_byte 2 st + p_ILType (mkILBoxedType (ILTypeSpec.Create(TypeProviders.GetILTypeRefOfProvidedType(info.ProvidedType, range0), []))) st + true + + | TProvidedNamespaceRepr _ -> + p_byte 0 st + false +#endif + + | TILObjectRepr(TILObjectReprData(scope, nesting, td)) -> + p_byte 5 st + p_ILScopeRef scope st + (p_list p_ILTypeDef) nesting st + p_ILTypeDef td st + false + +and p_qualified_name_of_file qualifiedNameOfFile st = + let (QualifiedNameOfFile ident) = qualifiedNameOfFile + p_ident ident st + +and p_pragma pragma st = + let (ScopedPragma.WarningOff(range, warningNumber)) = pragma + p_tup2 p_range p_int (range, warningNumber) st + +and p_pragmas x st = p_list p_pragma x st + +and p_long_ident (x: LongIdent) st = p_list p_ident x st + +and p_trivia (x: SyntaxTrivia.IdentTrivia) st = pfailwith st (nameof p_trivia) + +and p_syn_long_ident (x: SynLongIdent) st = + let (SynLongIdent(id, dotRanges, trivia)) = x + p_tup3 p_long_ident (p_list p_range) (p_list (p_option p_trivia)) (id, dotRanges, trivia) st + +and p_syn_type (x: SynType) st = pfailwith st (nameof p_syn_type) + +and p_syn_open_decl_target (x: SynOpenDeclTarget) st = + match x with + | SynOpenDeclTarget.ModuleOrNamespace(longId, range) -> + p_byte 0 st + p_tup2 p_syn_long_ident p_range (longId, range) st + | SynOpenDeclTarget.Type(typeName, range) -> + p_byte 1 st + p_tup2 p_syn_type p_range (typeName, range) st + +and p_tup_info (tupInfo: TupInfo) st = + let (TupInfo.Const c) = tupInfo + p_bool c st + +and p_nullness (nullness: Nullness) st = + match nullness.Evaluate() with + | NullnessInfo.WithNull -> p_byte 0 st + | NullnessInfo.WithoutNull -> p_byte 1 st + | NullnessInfo.AmbivalentToNull -> p_byte 2 st + +and p_typars = p_list p_tpref + +and p_module_or_namespace_contents (x: ModuleOrNamespaceContents) st = + match x with + | TMDefs defs -> + p_byte 0 st + p_list p_module_or_namespace_contents defs st + | TMDefOpens openDecls -> + p_byte 1 st + p_list p_open_decl openDecls st + | TMDefLet(binding, range) -> + p_byte 2 st + p_tup2 p_bind_new p_range (binding, range) st + | TMDefDo(expr, range) -> + p_byte 3 st + p_tup2 p_expr_new p_range (expr, range) st + | TMDefRec(isRec, opens, tycons, bindings, range) -> + p_byte 4 st + + p_tup5 + p_bool + (p_list p_open_decl) + (p_list p_entity_spec_data_new) + (p_list p_binding) + p_range + (isRec, opens, tycons, bindings, range) + st + +and p_checked_impl_file_contents = p_module_or_namespace_contents + +and p_named_debug_point_key (x: NamedDebugPointKey) st = + p_tup2 p_range p_string (x.Range, x.Name) st + +and p_named_debug_points = p_Map p_named_debug_point_key p_range + +and p_anon_recd_types = p_stamp_map p_anonInfo + +and p_open_decl (x: OpenDeclaration) st = + p_tup6 + p_syn_open_decl_target + (p_option p_range) + (p_list p_tcref_new) + p_tys + p_range + p_bool + (x.Target, x.Range, x.Modules, x.Types, x.AppliedScope, x.IsOwnNamespace) + st + +and p_checked_impl_file file st = + let (CheckedImplFile(qualifiedNameOfFile, + pragmas, + signature, + contents, + hasExplicitEntryPoint, + isScript, + anonRecdTypeInfo, + namedDebugPointsForInlinedCode)) = + file + + p_qualified_name_of_file qualifiedNameOfFile st + p_pragmas pragmas st + p_modul_typ_new signature st + p_checked_impl_file_contents contents st + p_bool hasExplicitEntryPoint st + p_bool isScript st + p_anon_recd_types anonRecdTypeInfo st + p_named_debug_points namedDebugPointsForInlinedCode st + +let p_context_info (x: ContextInfo) st = + match x with + | ContextInfo.NoContext -> p_byte 0 st + | ContextInfo.IfExpression range -> + p_byte 1 st + p_range range st + | ContextInfo.OmittedElseBranch range -> + p_byte 2 st + p_range range st + | ContextInfo.ElseBranchResult range -> + p_byte 3 st + p_range range st + | ContextInfo.RecordFields -> p_byte 4 st + | ContextInfo.TupleInRecordFields -> p_byte 5 st + | ContextInfo.CollectionElement(bool, range) -> + p_byte 6 st + p_bool bool st + p_range range st + | ContextInfo.ReturnInComputationExpression -> p_byte 7 st + | ContextInfo.YieldInComputationExpression -> p_byte 8 st + | ContextInfo.RuntimeTypeTest bool -> + p_byte 9 st + p_bool bool st + | ContextInfo.DowncastUsedInsteadOfUpcast bool -> + p_byte 10 st + p_bool bool st + | ContextInfo.FollowingPatternMatchClause range -> + p_byte 11 st + p_range range st + | ContextInfo.PatternMatchGuard range -> + p_byte 12 st + p_range range st + | ContextInfo.SequenceExpression ttype -> + p_byte 13 st + p_ty ttype st + +let p_safe_init_data (x: SafeInitData) st = + match x with + | SafeInitField(recdFieldRef, recdField) -> + p_byte 0 st + p_rfref recdFieldRef st + p_recdfield_spec recdField st + | NoSafeInitInfo -> p_byte 1 st + +let p_ctor_info (x: CtorInfo) st = + p_int x.ctorShapeCounter st + p_option p_Val x.safeThisValOpt st + p_safe_init_data x.safeInitInfo st + p_bool x.ctorIsImplicit st + +let p_module_and_namespace (s: string, l: ModuleOrNamespaceRef list) st = + p_string s st + p_list (p_tcref "test") l st + +let p_union_case_info (UnionCaseInfo(typeInst, ucref)) st = + p_tys_new typeInst st + p_ucref ucref st + +let p_item (x: Item) st = + match x with + | Item.Value vref -> + p_byte 0 st + p_vref "test" vref st + p_non_null_slot p_Val_new vref.binding st + | Item.UnqualifiedType tcrefs -> + p_byte 1 st + p_list (p_tcref "test") tcrefs st + | Item.UnionCase(unionCaseInfo, hasAttrs) -> + p_byte 2 st + p_union_case_info unionCaseInfo st + p_bool hasAttrs st + | Item.ExnCase tcref -> + p_byte 3 st + p_tcref "test" tcref st + | _ -> () + +let p_name_resolution_env (env: NameResolutionEnv) st = + // eDisplayEnv + p_Map p_string p_item env.eUnqualifiedItems st + // eUnqualifiedEnclosingTypeInsts + // ePatItems + (p_list p_module_and_namespace) (env.eModulesAndNamespaces |> Map.toList) st +// eFullyQualifiedModulesAndNamespaces +// eFieldLabels +// eUnqualifiedRecordOrUnionTypeInsts +// eTyconsByAccessNames +// eFullyQualifiedTyconsByAccessNames +// eTyconsByDemangledNameAndArity +// eFullyQualifiedTyconsByDemangledNameAndArity +// eIndexedExtensionMembers +// eUnindexedExtensionMembers +// eTypars + +let p_tc_env (tcEnv: TcEnv) (st: WriterState) = + p_name_resolution_env tcEnv.eNameResEnv st + // tcEnv.eUngeneralizableItems + p_list p_ident tcEnv.ePath st + p_cpath tcEnv.eCompPath st + p_cpath tcEnv.eAccessPath st + // tcEnv.eAccessRights + p_list p_cpath tcEnv.eInternalsVisibleCompPaths st + p_modul_typ tcEnv.eModuleOrNamespaceTypeAccumulator.Value st + p_context_info tcEnv.eContextInfo st + p_option (p_tcref "test") tcEnv.eFamilyType st + p_option p_ctor_info tcEnv.eCtorInfo st + p_option p_string tcEnv.eCallerMemberName st + p_list (p_list (p_ArgReprInfo)) tcEnv.eLambdaArgInfos st + p_bool tcEnv.eIsControlFlow st +// tcEnv.eCachedImplicitYieldExpressions + +let p_tcs_root_sig (qualifiedNameOfFile, moduleOrNamespaceType) st = + p_tup2 p_qualified_name_of_file p_modul_typ_new (qualifiedNameOfFile, moduleOrNamespaceType) st + +// pickling top + +let pickleSharedData sharedData st = + p_tup3 + p_attribs + p_attribs + p_attribs + (sharedData.TopAttribs.mainMethodAttrs, sharedData.TopAttribs.netModuleAttrs, sharedData.TopAttribs.assemblyAttrs) + st + +let pickleCheckedImplFile checkedImplFile st = p_checked_impl_file checkedImplFile st + +let pickleTcState (tcState: TcState) (st: WriterState) = + p_ccuref_new tcState.tcsCcu st + p_tc_env tcState.tcsTcSigEnv st + p_tc_env tcState.tcsTcImplEnv st + p_bool tcState.tcsCreatesGeneratedProvidedTypes st + (p_list p_tcs_root_sig) (tcState.tcsRootSigs.ToList()) st + p_list p_qualified_name_of_file (tcState.tcsRootImpls.ToList()) st + p_modul_typ_new tcState.tcsCcuSig st + p_list p_open_decl tcState.tcsImplicitOpenDeclarations st + +// unpickling + +let u_stamp = u_int64 + +let u_stamp_map uv = u_Map u_stamp uv + +let u_non_null_slot f st = + let tag = u_byte st + + match tag with + | 0 -> Unchecked.defaultof<_> + | 1 -> f st + | n -> ufailwith st ("u_option: found number " + string n) + +let u_ILTypeDefAdditionalFlags st : ILTypeDefAdditionalFlags = + let i = u_int32 st + enum i + +let u_ILTypeDef st : ILTypeDef = + let name = u_string st + let attributes = System.Reflection.TypeAttributes.Public + let layout = ILTypeDefLayout.Auto + let implements = Unchecked.defaultof<_> + let genericParams = [] + let extends = Unchecked.defaultof<_> + let methods = ILMethodDefs(fun () -> [||]) + let nestedTypes = Unchecked.defaultof<_> + let fields = Unchecked.defaultof<_> + let methodImpls = Unchecked.defaultof<_> + let events = Unchecked.defaultof<_> + let properties = Unchecked.defaultof<_> + let additionalFlags = u_ILTypeDefAdditionalFlags st + let securityDeclsStored = ILSecurityDecls([||]) + // TODO: fill this in + let customAttrsStored = ILAttributesStored.Given(ILAttributes.Empty) + + ILTypeDef( + name, + attributes, + layout, + implements, + genericParams, + extends, + methods, + nestedTypes, + fields, + methodImpls, + events, + properties, + additionalFlags, + securityDeclsStored, + customAttrsStored + ) + +let u_tyar_spec_data_new st = + let a, c, d, e, g, stamp = + u_tup6 u_ident u_attribs u_int64 u_tyar_constraints u_xmldoc u_stamp st + + { + typar_id = a + typar_stamp = stamp + typar_flags = TyparFlags(int32 d) + typar_solution = None + typar_astype = Unchecked.defaultof<_> + typar_opt_data = + match g, e, c with + | doc, [], [] when doc.IsEmpty -> None + | _ -> + Some + { + typar_il_name = None + typar_xmldoc = g + typar_constraints = e + typar_attribs = c + typar_is_contravariant = false + } + } + +let u_tyar_spec_new st = + u_osgn_decl st.itypars u_tyar_spec_data_new st + +let u_tyar_specs_new = u_list u_tyar_spec_new + +let rec u_ty_new st : TType = + let tag = u_byte st + + match tag with + | 0 -> + let tupInfo, l = u_tup2 u_tup_info u_tys_new st + TType_tuple(tupInfo, l) + + | 1 -> + let tyconRef, typeInstantiation, nullness, binding = + u_tup4 u_tcref u_tys_new u_nullness (u_non_null_slot u_entity_spec_new) st + + tyconRef.binding <- binding + TType_app(tyconRef, typeInstantiation, nullness) + + | 2 -> + let (domainType, rangeType, nullness) = u_tup3 u_ty_new u_ty_new u_nullness st + TType_fun(domainType, rangeType, nullness) + + | 3 -> + let (typar, nullness, solution, stamp) = + u_tup4 u_tpref u_nullness (u_option u_ty_new) u_stamp st + + typar.typar_solution <- solution + typar.typar_stamp <- stamp + TType_var(typar, nullness) + + | 4 -> + let (tps, r) = u_tup2 u_typars u_ty_new st + + TType_forall(tps, r) + + | 5 -> + let unt = u_measure_expr st + TType_measure unt + + | 6 -> + let uc, tinst = u_tup2 u_ucref u_tys_new st + TType_ucase(uc, tinst) + + | 7 -> + let anonInfo, l = u_tup2 u_anonInfo u_tys_new st + TType_anon(anonInfo, l) + | _ -> ufailwith st (nameof u_ty_new) + +and u_tys_new = u_list u_ty_new + +and u_expr_new st : Expr = + let tag = u_byte st + + match tag with + | 0 -> + let e = u_expr_new st + let r = ref e + Expr.Link r + | 1 -> + let a = u_const st + let b = u_dummy_range st + let c = u_ty_new st + Expr.Const(a, b, c) + | 2 -> + let valRef = u_vref_new st + let flags = u_vrefFlags st + let range = u_dummy_range st + let binding = (u_non_null_slot u_Val_new) st + + valRef.binding <- binding + let expr = Expr.Val(valRef, flags, range) + expr + | 3 -> + let a = u_op_new st + let b = u_tys_new st + let c = u_exprs_new st + let d = u_dummy_range st + Expr.Op(a, b, c, d) + | 4 -> + let a = u_expr_new st + let b = u_expr_new st + let c = u_int st + let d = u_dummy_range st + + let dir = + match c with + | 0 -> NormalSeq + | 1 -> ThenDoSeq + | _ -> ufailwith st "specialSeqFlag" + + Expr.Sequential(a, b, dir, d) + | 5 -> + let a0 = u_option u_Val st + let b0 = u_option u_Val st + let b1 = u_Vals st + let c = u_expr_new st + let d = u_dummy_range st + let e = u_ty_new st + Expr.Lambda(newUnique (), a0, b0, b1, c, d, e) + | 6 -> + let b = u_tyar_specs_new st + let c = u_expr_new st + let d = u_dummy_range st + let e = u_ty_new st + Expr.TyLambda(newUnique (), b, c, d, e) + | 7 -> + let a1 = u_expr_new st + let a2 = u_ty_new st + let b = u_tys_new st + let c = u_exprs_new st + let d = u_dummy_range st + let expr = Expr.App(a1, a2, b, c, d) + expr + | 8 -> + let a = u_binds st + let b = u_expr_new st + let c = u_dummy_range st + Expr.LetRec(a, b, c, Construct.NewFreeVarsCache()) + | 9 -> + let a = u_bind st + let b = u_expr_new st + let c = u_dummy_range st + Expr.Let(a, b, c, Construct.NewFreeVarsCache()) + | 10 -> + let a = u_dummy_range st + let b = u_dtree st + let c = u_targets st + let d = u_dummy_range st + let e = u_ty_new st + Expr.Match(DebugPointAtBinding.NoneAtSticky, a, b, c, d, e) + | 11 -> + let b = u_ty_new st + let c = (u_option u_Val) st + let d = u_expr_new st + let e = u_methods st + let f = u_intfs st + let g = u_dummy_range st + Expr.Obj(newUnique (), b, c, d, e, f, g) + | 12 -> + let a = u_constraints st + let b = u_expr_new st + let c = u_expr_new st + let d = u_dummy_range st + Expr.StaticOptimization(a, b, c, d) + | 13 -> + let a = u_tyar_specs_new st + let b = u_expr_new st + let c = u_dummy_range st + Expr.TyChoose(a, b, c) + | 14 -> + let b = u_expr_new st + let c = u_dummy_range st + let d = u_ty_new st + Expr.Quote(b, ref None, false, c, d) // isFromQueryExpression=false + | 15 -> + let traitInfo = u_trait st + let m = u_dummy_range st + Expr.WitnessArg(traitInfo, m) + | 16 -> + let m = u_dummy_range st + let expr = u_expr_new st + Expr.DebugPoint(DebugPointAtLeafExpr.Yes m, expr) + | _ -> ufailwith st "u_expr" + +and u_exprs_new = u_list u_expr_new + +and u_ucref_new st = + let tcref, caseName, binding = + u_tup3 u_tcref u_string (u_non_null_slot u_entity_spec_new) st + + tcref.binding <- binding + UnionCaseRef(tcref, caseName) + +and u_op_new st = + let tag = u_byte st + + match tag with + | 0 -> + let a = u_ucref_new st + TOp.UnionCase a + | 1 -> + let a = u_tcref st + TOp.ExnConstr a + | 2 -> TOp.Tuple tupInfoRef + | 3 -> + let b = u_tcref st + TOp.Recd(RecdExpr, b) + | 4 -> + let a = u_rfref st + TOp.ValFieldSet a + | 5 -> + let a = u_rfref st + TOp.ValFieldGet a + | 6 -> + let a = u_tcref st + TOp.UnionCaseTagGet a + | 7 -> + let a = u_ucref st + let b = u_int st + TOp.UnionCaseFieldGet(a, b) + | 8 -> + let a = u_ucref st + let b = u_int st + TOp.UnionCaseFieldSet(a, b) + | 9 -> + let a = u_tcref st + let b = u_int st + TOp.ExnFieldGet(a, b) + | 10 -> + let a = u_tcref st + let b = u_int st + TOp.ExnFieldSet(a, b) + | 11 -> + let a = u_int st + TOp.TupleFieldGet(tupInfoRef, a) + | 12 -> + let a = (u_list u_ILInstr) st + let b = u_tys st + TOp.ILAsm(a, b) + | 13 -> TOp.RefAddrGet false // ok to set the 'readonly' flag on these operands to false on re-read since the flag is only used for typechecking purposes + | 14 -> + let a = u_ucref st + TOp.UnionCaseProof a + | 15 -> TOp.Coerce + | 16 -> + let a = u_trait st + TOp.TraitCall a + | 17 -> + let a = u_lval_op_kind st + let b = u_vref st + TOp.LValueOp(a, b) + | 18 -> + let a1, a2, a3, a4, a5, a7, a8, a9 = + (u_tup8 u_bool u_bool u_bool u_bool u_vrefFlags u_bool u_bool u_ILMethodRef) st + + let b = u_tys st + let c = u_tys st + let d = u_tys st + TOp.ILCall(a1, a2, a3, a4, a5, a7, a8, a9, b, c, d) + | 19 -> TOp.Array + | 20 -> TOp.While(DebugPointAtWhile.No, NoSpecialWhileLoopMarker) + | 21 -> + let dir = + match u_int st with + | 0 -> FSharpForLoopUp + | 1 -> CSharpForLoopUp + | 2 -> FSharpForLoopDown + | _ -> failwith "unknown for loop" + + TOp.IntegerForLoop(DebugPointAtFor.No, DebugPointAtInOrTo.No, dir) + | 22 -> TOp.Bytes(u_bytes st) + | 23 -> TOp.TryWith(DebugPointAtTry.No, DebugPointAtWith.No) + | 24 -> TOp.TryFinally(DebugPointAtTry.No, DebugPointAtFinally.No) + | 25 -> + let a = u_rfref st + TOp.ValFieldGetAddr(a, false) + | 26 -> TOp.UInt16s(u_array u_uint16 st) + | 27 -> TOp.Reraise + | 28 -> + let a = u_ucref st + let b = u_int st + TOp.UnionCaseFieldGetAddr(a, b, false) + | 29 -> TOp.Tuple tupInfoStruct + | 30 -> + let a = u_int st + TOp.TupleFieldGet(tupInfoStruct, a) + | 31 -> + let info = u_anonInfo st + TOp.AnonRecd info + | 32 -> + let info = u_anonInfo st + let n = u_int st + TOp.AnonRecdGet(info, n) + | _ -> ufailwith st "u_op" + +and u_entity_spec_data_new st : Entity = + let typars = u_tyar_specs_new st + let logicalName = u_string st + let compiledName = u_option u_string st + let range = u_range st + let stamp = u_stamp st + let pubPath = u_option u_pubpath st + let access = u_access st + let tyconReprAccess = u_access st + let attribs = u_attribs st + let tyconRepr = u_tycon_repr_new st + let typeAbbrev = u_option u_ty_new st + let tyconTcaug = u_tcaug_new st + let _x10 = u_string st + let kind = u_kind st + let flags = u_int64 st + let cpath = u_option u_cpath st + let modulType = u_lazy u_modul_typ_new st + let exnInfo = u_exnc_repr st + let xmlDoc = u_used_space1 u_xmldoc st + + // We use a bit that was unused in the F# 2.0 format to indicate two possible representations in the F# 3.0 tycon_repr format + //let x7 = x7f (x11 &&& EntityFlags.ReservedBitForPickleFormatTyconReprFlag <> 0L) + //let x11 = x11 &&& ~~~EntityFlags.ReservedBitForPickleFormatTyconReprFlag + + { + entity_typars = LazyWithContext.NotLazy typars + entity_stamp = stamp + entity_logical_name = logicalName + entity_range = range + entity_pubpath = pubPath + entity_attribs = attribs + entity_tycon_repr = tyconRepr false + entity_tycon_tcaug = tyconTcaug + entity_flags = EntityFlags flags + entity_cpath = cpath + entity_modul_type = MaybeLazy.Lazy modulType + entity_il_repr_cache = newCache () + entity_opt_data = + match compiledName, kind, xmlDoc, typeAbbrev, access, tyconReprAccess, exnInfo with + | None, TyparKind.Type, None, None, TAccess [], TAccess [], TExnNone -> None + | _ -> + Some + { Entity.NewEmptyEntityOptData() with + entity_compiled_name = compiledName + entity_kind = kind + entity_xmldoc = defaultArg xmlDoc XmlDoc.Empty + entity_xmldocsig = System.String.Empty + entity_tycon_abbrev = typeAbbrev + entity_accessibility = access + entity_tycon_repr_accessibility = tyconReprAccess + entity_exn_info = exnInfo + } + } + +and u_entity_spec_new st = + u_osgn_decl st.ientities u_entity_spec_data_new st + +and u_ValData_new st = + let logicalName = u_string st + let compiledName = u_option u_string st + let ranges = u_ranges st + let valType = u_ty_new st + let stamp = u_stamp st + let flags = u_int64 st + let memberInfo = u_option u_member_info st + let attribs = u_attribs st + let valReprInfo = u_option u_ValReprInfo st + let xmlDocSig = u_string st + let valAccess = u_access st + let declEntity = u_parentref st + let valConst = u_option u_const st + let xmlDoc = u_used_space1 u_xmldoc st + + { + val_logical_name = logicalName + val_range = + (match ranges with + | None -> range0 + | Some(a, _) -> a) + val_type = valType + val_stamp = stamp + val_flags = ValFlags flags + val_opt_data = + match compiledName, ranges, valReprInfo, valConst, valAccess, xmlDoc, memberInfo, declEntity, xmlDocSig, attribs with + | None, None, None, None, TAccess [], None, None, ParentNone, "", [] -> None + | _ -> + Some + { + val_compiled_name = compiledName + val_other_range = + (match ranges with + | None -> None + | Some(_, b) -> Some(b, true)) + val_defn = None + val_repr_info = valReprInfo + val_repr_info_for_display = None + arg_repr_info_for_display = None + val_const = valConst + val_access = valAccess + val_xmldoc = defaultArg xmlDoc XmlDoc.Empty + val_other_xmldoc = None + val_member_info = memberInfo + val_declaring_entity = declEntity + val_xmldocsig = xmlDocSig + val_attribs = attribs + } + } + +and u_Val_new st = u_osgn_decl st.ivals u_ValData_new st + +and u_modul_typ_new st = + let x1, x3, x5 = u_tup3 u_istype (u_qlist u_Val_new) (u_qlist u_entity_spec_new) st + ModuleOrNamespaceType(x1, x3, x5) + +and u_tcaug_new st : TyconAugmentation = + let a1, a2, a3, b2, c, d, e, g, _space = + u_tup9 + (u_option (u_tup2 u_vref u_vref)) + (u_option u_vref) + (u_option (u_tup3 u_vref u_vref u_vref)) + (u_option (u_tup2 u_vref u_vref)) + (u_list (u_tup2 u_string u_vref)) + (u_list (u_tup3 u_ty_new u_bool u_dummy_range)) + (u_option u_ty_new) + u_bool + (u_space 1) + st + + { + tcaug_compare = a1 + tcaug_compare_withc = a2 + tcaug_hash_and_equals_withc = a3 |> Option.map (fun (v1, v2, v3) -> (v1, v2, v3, None)) + tcaug_equals = b2 + // only used for code generation and checking - hence don't care about the values when reading back in + tcaug_hasObjectGetHashCode = false + tcaug_adhoc_list = ResizeArray<_>(c |> List.map (fun (_, vref) -> (false, vref))) + tcaug_adhoc = NameMultiMap.ofList c + tcaug_interfaces = d + tcaug_super = e + // pickled type definitions are always closed (i.e. no more intrinsic members allowed) + tcaug_closed = true + tcaug_abstract = g + } + +and u_ccu_data st : CcuData = + let fileName = u_option u_string st + let ilScopeRef = u_ILScopeRef st + let stamp = u_stamp st + let qualifiedName = u_option u_string st + let sourceCodeDirectory = u_string st + let isFSharp = u_bool st +#if !NO_TYPEPROVIDERS + let isProviderGenerated = u_bool st +#endif + let usesFSharp20PlusQuotations = u_bool st + let contents = u_entity_spec_data_new st + + { + FileName = fileName + ILScopeRef = ilScopeRef + Stamp = stamp + QualifiedName = qualifiedName + SourceCodeDirectory = sourceCodeDirectory + IsFSharp = isFSharp +#if !NO_TYPEPROVIDERS + IsProviderGenerated = isProviderGenerated + InvalidateEvent = Unchecked.defaultof<_> + ImportProvidedType = Unchecked.defaultof<_> +#endif + UsesFSharp20PlusQuotations = usesFSharp20PlusQuotations + Contents = contents + TryGetILModuleDef = Unchecked.defaultof<_> + MemberSignatureEquality = Unchecked.defaultof<_> + TypeForwarders = Unchecked.defaultof<_> + XmlDocumentationInfo = Unchecked.defaultof<_> + } + +and u_ccuref_new st : CcuThunk = + let target, name = u_tup2 u_ccu_data u_string st + + { target = target; name = name } + +and u_nleref_new st = + let ccu, strings = u_tup2 u_ccuref_new (u_array u_string) st + + NonLocalEntityRef(ccu, strings) + +and u_tcref_new st : EntityRef = + let tag = u_byte st + + match tag with + | 0 -> u_local_item_ref st.ientities st |> ERefLocal + | 1 -> u_nleref_new st |> ERefNonLocal + | _ -> ufailwith st "u_item_ref" + +and u_nonlocal_val_ref_new st : NonLocalValOrMemberRef = + let a = u_tcref_new st + let b1 = u_option u_string st + let b2 = u_bool st + let b3 = u_string st + let c = u_int st + let d = u_option u_ty_new st + + { + EnclosingEntity = a + ItemKey = + ValLinkageFullKey( + { + MemberParentMangledName = b1 + MemberIsOverride = b2 + LogicalName = b3 + TotalArgCount = c + }, + d + ) + } + +and u_vref_new st : ValRef = + let tag = u_byte st + + match tag with + | 0 -> u_local_item_ref st.ivals st |> VRefLocal + | 1 -> u_nonlocal_val_ref_new st |> VRefNonLocal + | _ -> ufailwith st "u_item_ref" + +and u_bind_new st = + let a = u_Val_new st + let b = u_expr_new st + TBind(a, b, DebugPointAtBinding.NoneAtSticky) + +and u_binding st : ModuleOrNamespaceBinding = + let tag = u_byte st + + match tag with + | 0 -> + let binding = u_bind st + ModuleOrNamespaceBinding.Binding binding + | 1 -> + let moduleOrNamespace, moduleOrNamespaceContents = + u_tup2 u_entity_spec_new u_module_or_namespace_contents st + + ModuleOrNamespaceBinding.Module(moduleOrNamespace, moduleOrNamespaceContents) + | _ -> ufailwith st (nameof u_binding) + +and u_tycon_repr_new st = + let tag1 = u_byte st + + match tag1 with + | 0 -> (fun _flagBit -> TNoRepr) + | 1 -> + let tag2 = u_byte st + + match tag2 with + // Records historically use a different format to other FSharpTyconRepr + | 0 -> + let v = u_rfield_table st + + (fun _flagBit -> + TFSharpTyconRepr + { + fsobjmodel_cases = Construct.MakeUnionCases [] + fsobjmodel_kind = TFSharpRecord + fsobjmodel_vslots = [] + fsobjmodel_rfields = v + }) + + // Unions without static fields historically use a different format to other FSharpTyconRepr + | 1 -> + let v = u_list u_unioncase_spec st + (fun _flagBit -> Construct.MakeUnionRepr v) + + | 2 -> + let v = u_ILType st + // This is the F# 3.0 extension to the format used for F# provider-generated types, which record an ILTypeRef in the format + // You can think of an F# 2.0 reader as always taking the path where 'flagBit' is false. Thus the F# 2.0 reader will + // interpret provider-generated types as TAsmRepr. + (fun flagBit -> + if flagBit then + let iltref = v.TypeRef + + match st.iILModule with + | None -> TNoRepr + | Some iILModule -> + try + let rec find acc enclosingTypeNames (tdefs: ILTypeDefs) = + match enclosingTypeNames with + | [] -> List.rev acc, tdefs.FindByName iltref.Name + | h :: t -> + let nestedTypeDef = tdefs.FindByName h + find (nestedTypeDef :: acc) t nestedTypeDef.NestedTypes + + let nestedILTypeDefs, ilTypeDef = find [] iltref.Enclosing iILModule.TypeDefs + TILObjectRepr(TILObjectReprData(st.iilscope, nestedILTypeDefs, ilTypeDef)) + with _ -> + System.Diagnostics.Debug.Assert( + false, + sprintf "failed to find IL backing metadata for cross-assembly generated type %s" iltref.FullName + ) + + TNoRepr + else + TAsmRepr v) + + | 3 -> + let v = u_tycon_objmodel_data st + (fun _flagBit -> TFSharpTyconRepr v) + + | 4 -> + let v = u_ty st + (fun _flagBit -> TMeasureableRepr v) + + | _ -> ufailwith st "u_tycon_repr" + + // Unions with static fields use a different format to other FSharpTyconRepr + | 2 -> + let cases = u_array u_unioncase_spec st + let data = u_tycon_objmodel_data st + + fun _flagBit -> + TFSharpTyconRepr + { data with + fsobjmodel_cases = Construct.MakeUnionCases(Array.toList cases) + } + + | 5 -> + // | TILObjectRepr (TILObjectReprData (scope, nesting, td)) -> + let scope = u_ILScopeRef st + let nesting = u_list u_ILTypeDef st + let definition = u_ILTypeDef st + + (fun _flagBit -> TILObjectRepr(TILObjectReprData(scope, nesting, definition))) + + | _ -> ufailwith st "u_tycon_repr" + +and u_qualified_name_of_file st = + let ident = u_ident st + QualifiedNameOfFile(ident) + +and u_pragma st = + let range, warningNumber = u_tup2 u_range u_int st + + ScopedPragma.WarningOff(range, warningNumber) + +and u_pragmas st = u_list u_pragma st + +and u_long_ident st = u_list u_ident st + +and u_trivia st : SyntaxTrivia.IdentTrivia = ufailwith st (nameof p_trivia) + +and u_syn_long_ident st = + let id, dotRanges, trivia = + u_tup3 u_long_ident (u_list u_range) (u_list (u_option u_trivia)) st + + SynLongIdent(id, dotRanges, trivia) + +and u_syn_type st : SynType = ufailwith st (nameof u_syn_type) + +and u_syn_open_decl_target st : SynOpenDeclTarget = + let tag = u_byte st + + match tag with + | 0 -> + let longId, range = u_tup2 u_syn_long_ident u_range st + + SynOpenDeclTarget.ModuleOrNamespace(longId, range) + | 1 -> + let typeName, range = u_tup2 u_syn_type u_range st + SynOpenDeclTarget.Type(typeName, range) + | _ -> ufailwith st (nameof u_syn_open_decl_target) + +and u_tup_info st : TupInfo = + let c = u_bool st + TupInfo.Const c + +and u_nullness st = + let tag = u_byte st + + let nullnessInfo = + match tag with + | 0 -> NullnessInfo.WithNull + | 1 -> NullnessInfo.WithoutNull + | 2 -> NullnessInfo.AmbivalentToNull + | _ -> ufailwith st (nameof u_nullness) + + Nullness.Known nullnessInfo + +and u_typars = u_list u_tpref + +and u_module_or_namespace_contents st : ModuleOrNamespaceContents = + let tag = u_byte st + + match tag with + | 0 -> + let defs = u_list u_module_or_namespace_contents st + TMDefs defs + | 1 -> + let openDecls = u_list u_open_decl st + TMDefOpens openDecls + | 2 -> + let binding, range = u_tup2 u_bind_new u_range st + TMDefLet(binding, range) + | 3 -> + let expr, range = u_tup2 u_expr_new u_range st + TMDefDo(expr, range) + | 4 -> + let isRec, opens, tycons, bindings, range = + u_tup5 u_bool (u_list u_open_decl) (u_list u_entity_spec_data_new) (u_list u_binding) u_range st + + TMDefRec(isRec, opens, tycons, bindings, range) + | _ -> ufailwith st (nameof u_module_or_namespace_contents) + +and u_checked_impl_file_contents = u_module_or_namespace_contents + +and u_named_debug_point_key st : NamedDebugPointKey = + let range, name = u_tup2 u_range u_string st + + { Range = range; Name = name } + +and u_named_debug_points = u_Map u_named_debug_point_key u_range + +and u_anon_recd_types = u_stamp_map u_anonInfo + +and u_open_decl st : OpenDeclaration = + let target, range, modules, types, appliedScope, isOwnNamespace = + u_tup6 u_syn_open_decl_target (u_option u_range) (u_list u_tcref_new) u_tys u_range u_bool st + + { + Target = target + Range = range + Modules = modules + Types = types + AppliedScope = appliedScope + IsOwnNamespace = isOwnNamespace + } + +and u_checked_impl_file st = + let qualifiedNameOfFile, pragmas, signature, contents, hasExplicitEntryPoint, isScript, anonRecdTypeInfo, namedDebugPointsForInlinedCode = + u_tup8 + u_qualified_name_of_file + u_pragmas + u_modul_typ_new + u_checked_impl_file_contents + u_bool + u_bool + u_anon_recd_types + u_named_debug_points + st + + CheckedImplFile( + qualifiedNameOfFile, + pragmas, + signature, + contents, + hasExplicitEntryPoint, + isScript, + anonRecdTypeInfo, + namedDebugPointsForInlinedCode + ) + +let u_context_info st : ContextInfo = + let tag = u_byte st + + match tag with + | 0 -> ContextInfo.NoContext + | 1 -> + let range = u_range st + ContextInfo.IfExpression range + | 2 -> + let range = u_range st + ContextInfo.OmittedElseBranch range + | 3 -> + let range = u_range st + ContextInfo.ElseBranchResult range + | 4 -> ContextInfo.RecordFields + | 5 -> ContextInfo.TupleInRecordFields + | 6 -> + let bool = u_bool st + let range = u_range st + ContextInfo.CollectionElement(bool, range) + | 7 -> ContextInfo.ReturnInComputationExpression + | 8 -> ContextInfo.YieldInComputationExpression + | 9 -> + let bool = u_bool st + ContextInfo.RuntimeTypeTest bool + | 10 -> + let bool = u_bool st + ContextInfo.DowncastUsedInsteadOfUpcast bool + | 11 -> + let range = u_range st + ContextInfo.FollowingPatternMatchClause range + | 12 -> + let range = u_range st + ContextInfo.PatternMatchGuard range + | 13 -> + let ttype = u_ty st + ContextInfo.SequenceExpression ttype + | _ -> ufailwith st "u_context_info" + +let u_safe_init_data st : SafeInitData = + let tag = u_byte st + + match tag with + | 0 -> + let recdFieldRef = u_rfref st + let recdField = u_recdfield_spec st + SafeInitField(recdFieldRef, recdField) + | 1 -> NoSafeInitInfo + | _ -> ufailwith st "u_safe_init_data" + +let u_ctor_info st : CtorInfo = + let ctorShapeCounter = u_int st + let safeThisValOpt = u_option u_Val st + let safeInitInfo = u_safe_init_data st + let ctorIsImplicit = u_bool st + + { + ctorShapeCounter = ctorShapeCounter + safeThisValOpt = safeThisValOpt + safeInitInfo = safeInitInfo + ctorIsImplicit = ctorIsImplicit + } + +let u_module_and_namespace st : string * ModuleOrNamespaceRef list = + let s = u_string st + let l = u_list u_tcref st + s, l + +let u_union_case_info st = + let typeInst = u_tys_new st + let ucref = u_ucref st + UnionCaseInfo(typeInst, ucref) + +let u_item st : Item = + let tag = u_byte st + + match tag with + | 0 -> + let vref = u_vref st + let binding = u_non_null_slot u_Val_new st + vref.binding <- binding + Item.Value vref + | 1 -> + let tcrefs = u_list u_tcref st + Item.UnqualifiedType tcrefs + + | 2 -> + let unionCaseInfo = u_union_case_info st + let hasAttrs = u_bool st + Item.UnionCase(unionCaseInfo, hasAttrs) + | 3 -> + let tcref = u_tcref st + Item.ExnCase tcref + | _ -> ufailwith st "u_item" + +let u_name_resolution_env st : NameResolutionEnv = + let eUnqualifiedItems = u_Map u_string u_item st + + let eModulesAndNamespaces: NameMultiMap = + u_list u_module_and_namespace st |> Map.ofList + + let g: TcGlobals = Unchecked.defaultof<_> + + { NameResolutionEnv.Empty g with + eUnqualifiedItems = eUnqualifiedItems + eModulesAndNamespaces = eModulesAndNamespaces + } + +let u_tc_env (st: ReaderState) : TcEnv = + let eNameResEnv = u_name_resolution_env st + //let eUngeneralizableItems + let ePath = u_list u_ident st + let eCompPath = u_cpath st + let eAccessPath = u_cpath st + // eAccessRights + let eInternalsVisibleCompPaths = u_list u_cpath st + let eModuleOrNamespaceTypeAccumulator = u_modul_typ st + let eContextInfo = u_context_info st + let eFamilyType = u_option u_tcref st + let eCtorInfo = u_option u_ctor_info st + let eCallerMemberName = u_option u_string st + let eLambdaArgInfos = u_list (u_list u_ArgReprInfo) st + let eIsControlFlow = u_bool st + // eCachedImplicitYieldExpressions + + { + eNameResEnv = eNameResEnv + eUngeneralizableItems = List.empty + ePath = ePath + eCompPath = eCompPath + eAccessPath = eAccessPath + eAccessRights = AccessibleFromEverywhere + eInternalsVisibleCompPaths = eInternalsVisibleCompPaths + eModuleOrNamespaceTypeAccumulator = ref eModuleOrNamespaceTypeAccumulator + eContextInfo = eContextInfo + eFamilyType = eFamilyType + eCtorInfo = eCtorInfo + eCallerMemberName = eCallerMemberName + eLambdaArgInfos = eLambdaArgInfos + eIsControlFlow = eIsControlFlow + eCachedImplicitYieldExpressions = HashMultiMap(HashIdentity.Structural) + } + +let u_tcs_root_sig st = + let qualifiedNameOfFile, moduleOrNamespaceType = + u_tup2 u_qualified_name_of_file u_modul_typ_new st + + qualifiedNameOfFile, moduleOrNamespaceType + +// unpickling top + +let unpickleSharedData st = + let mainMethodAttrs, netModuleAttrs, assemblyAttrs = + u_tup3 u_attribs u_attribs u_attribs st + + let attribs = + { + mainMethodAttrs = mainMethodAttrs + netModuleAttrs = netModuleAttrs + assemblyAttrs = assemblyAttrs + } + + { TopAttribs = attribs } + +let unpickleCheckedImplFile st = u_checked_impl_file st + +let unpickleTcState (st: ReaderState) : TcState = + let tcsCcu = u_ccuref_new st + let tcsTcSigEnv = u_tc_env st + let tcsTcImplEnv = u_tc_env st + let tcsCreatesGeneratedProvidedTypes = u_bool st + let tcsRootSigs = u_list u_tcs_root_sig st + let tcsRootImpls = u_list u_qualified_name_of_file st + let tcsCcuSig = u_modul_typ_new st + let tcsImplicitOpenDeclarations = u_list u_open_decl st + + { + tcsCcu = tcsCcu + tcsCreatesGeneratedProvidedTypes = tcsCreatesGeneratedProvidedTypes + tcsTcSigEnv = tcsTcSigEnv + tcsTcImplEnv = tcsTcImplEnv + tcsRootSigs = RootSigs.FromList(qnameOrder, tcsRootSigs) + tcsRootImpls = RootImpls.Create(qnameOrder, tcsRootImpls) + tcsCcuSig = tcsCcuSig + tcsImplicitOpenDeclarations = tcsImplicitOpenDeclarations + } diff --git a/src/Compiler/Driver/fsc.fs b/src/Compiler/Driver/fsc.fs index 0e26f2db4ac..8c1fc1d1d23 100644 --- a/src/Compiler/Driver/fsc.fs +++ b/src/Compiler/Driver/fsc.fs @@ -54,6 +54,7 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.XmlDocFileWriter open FSharp.Compiler.CheckExpressionsOps +open FSharp.Compiler.ReuseTcResults.CachingDriver //---------------------------------------------------------------------------- // Reporting - warnings, errors @@ -149,7 +150,8 @@ let TypeCheck tcEnv0, openDecls0, inputs, - exiter: Exiter + exiter: Exiter, + outfile ) = try if isNil inputs then @@ -162,17 +164,93 @@ let TypeCheck let eagerFormat (diag: PhasedDiagnostic) = diag.EagerlyFormatCore true - CheckClosedInputSet( - ctok, - (fun () -> diagnosticsLogger.CheckForRealErrorsIgnoringWarnings), - tcConfig, - tcImports, - tcGlobals, - None, - tcInitialState, - eagerFormat, - inputs - ) + if tcConfig.reuseTcResults = ReuseTcResults.On then + let cachingDriver = CachingDriver(tcConfig) + + let tcCacheState = cachingDriver.GetTcCacheState(inputs) + + match tcCacheState with + | TcCacheState.Present files when files |> List.forall (fun (_file, canReuse) -> canReuse) -> + // TODO: last state should be sent back here, not the initial state + let _lastState, topAttrs, declaredImpls, tcEnvFromImpls = + cachingDriver.ReuseTcResults inputs + + tcInitialState, topAttrs, declaredImpls, tcEnvFromImpls + | TcCacheState.Present files when files |> List.exists (fun (_file, canReuse) -> canReuse) -> + let canReuse, cannotReuse = + files + |> List.partition (fun (_file, canReuse) -> canReuse) + |> fun (a, b) -> a |> List.map fst, b |> List.map fst + + let tcCurrentState, _, reusedImpls, _ = cachingDriver.ReuseTcResults canReuse + + let lastState, topAttrs, newImpls, tcEnvAtEndOfLastFile, tcStates = + CheckClosedInputSet( + ctok, + diagnosticsLogger.CheckForErrors, + tcConfig, + tcImports, + tcGlobals, + None, + tcCurrentState, + eagerFormat, + cannotReuse + ) + + let _tcResults = + List.zip3 cannotReuse newImpls tcStates + |> List.map (fun (input, impl, state) -> + { + Input = input + DeclaredImpl = impl + State = state + }) + + // TODO: cache new stuff + // cachingDriver.CacheTcResults(tcResults, topAttrs, tcEnvAtEndOfLastFile, tcGlobals, outfile) + + lastState, topAttrs, reusedImpls @ newImpls, tcEnvAtEndOfLastFile + + | _ -> + let lastState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile, tcStates = + CheckClosedInputSet( + ctok, + diagnosticsLogger.CheckForErrors, + tcConfig, + tcImports, + tcGlobals, + None, + tcInitialState, + eagerFormat, + inputs + ) + + let tcResults = + List.zip3 inputs declaredImpls tcStates + |> List.map (fun (input, impl, state) -> + { + Input = input + DeclaredImpl = impl + State = state + }) + + cachingDriver.CacheTcResults(tcResults, topAttrs, tcEnvAtEndOfLastFile, tcGlobals, outfile) + lastState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile + else + let lastState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile, _ = + CheckClosedInputSet( + ctok, + (fun () -> diagnosticsLogger.CheckForRealErrorsIgnoringWarnings), + tcConfig, + tcImports, + tcGlobals, + None, + tcInitialState, + eagerFormat, + inputs + ) + + lastState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile with exn -> errorRecovery exn rangeStartup exiter.Exit 1 @@ -473,6 +551,8 @@ let main1 disposables: DisposablesTracker ) = + CompilerGlobalState.stampCount <- 0L + // See Bug 735819 let lcidFromCodePage = let thread = Thread.CurrentThread @@ -511,6 +591,7 @@ let main1 ) tcConfigB.exiter <- exiter + tcConfigB.cmdLineArgs <- argv // Preset: --optimize+ -g --tailcalls+ (see 4505) SetOptimizeSwitch tcConfigB OptionSwitch.On @@ -692,7 +773,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" diff --git a/src/Compiler/FSComp.txt b/src/Compiler/FSComp.txt index eedaecbb9be..b0137486cba 100644 --- a/src/Compiler/FSComp.txt +++ b/src/Compiler/FSComp.txt @@ -1796,3 +1796,4 @@ featureDontWarnOnUppercaseIdentifiersInBindingPatterns,"Don't warn on uppercase featureDeprecatePlacesWhereSeqCanBeOmitted,"Deprecate places where 'seq' can be omitted" featureSupportValueOptionsAsOptionalParameters,"Support ValueOption as valid type for optional member parameters" featureSupportWarnWhenUnitPassedToObjArg,"Warn when unit is passed to a member accepting `obj` argument, e.g. `Method(o:obj)` will warn if called via `Method()`." +optsReuseTcResults,"Reuse previous typechecking results for faster compilation" diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj index 493248a11d3..69b3dc0dbfc 100644 --- a/src/Compiler/FSharp.Compiler.Service.fsproj +++ b/src/Compiler/FSharp.Compiler.Service.fsproj @@ -333,7 +333,6 @@ - @@ -464,6 +463,9 @@ + + + diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index eaba5aa6582..e03537bd111 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -2200,7 +2200,7 @@ type internal FsiDynamicCompiler // Typecheck. The lock stops the type checker running at the same time as the // server intellisense implementation (which is currently incomplete and #if disabled) - let tcState, topCustomAttrs, declaredImpls, tcEnvAtEndOfLastInput = + let tcState, topCustomAttrs, declaredImpls, tcEnvAtEndOfLastInput, _ = lock tcLockObject (fun _ -> CheckClosedInputSet( ctok, diff --git a/src/Compiler/TypedTree/CompilerGlobalState.fs b/src/Compiler/TypedTree/CompilerGlobalState.fs index 12dda2b08d8..7c93a7107d0 100644 --- a/src/Compiler/TypedTree/CompilerGlobalState.fs +++ b/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 \ No newline at end of file diff --git a/src/Compiler/TypedTree/CompilerGlobalState.fsi b/src/Compiler/TypedTree/CompilerGlobalState.fsi index 6f0dba79ddf..834825d671f 100644 --- a/src/Compiler/TypedTree/CompilerGlobalState.fsi +++ b/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) diff --git a/src/Compiler/TypedTree/TypedTree.fs b/src/Compiler/TypedTree/TypedTree.fs index 817730ec6ea..e94321ffba0 100644 --- a/src/Compiler/TypedTree/TypedTree.fs +++ b/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 [] 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,7 +5921,6 @@ type PickledCcuInfo = override _.ToString() = "PickledCcuInfo(...)" - /// Represents a set of free local values. Computed and cached by later phases /// (never cached type checking). Cached in expressions. Not pickled. type FreeLocals = Zset diff --git a/src/Compiler/TypedTree/TypedTree.fsi b/src/Compiler/TypedTree/TypedTree.fsi index 28ef5776e5a..eedbaef44f4 100644 --- a/src/Compiler/TypedTree/TypedTree.fsi +++ b/src/Compiler/TypedTree/TypedTree.fsi @@ -162,6 +162,8 @@ type ValFlags = member WithMakesNoCriticalTailcalls: ValFlags + member Flags: int64 + /// Represents the kind of a type parameter [] 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 diff --git a/src/Compiler/TypedTree/TypedTreePickle.fs b/src/Compiler/TypedTree/TypedTreePickle.fs index d2b3bd0ec79..291139e892f 100644 --- a/src/Compiler/TypedTree/TypedTreePickle.fs +++ b/src/Compiler/TypedTree/TypedTreePickle.fs @@ -802,7 +802,11 @@ let check (ilscope: ILScopeRef) (inMap: NodeInTable<_,_>) = for i = 0 to inMap.Count - 1 do let n = inMap.Get i if not (inMap.IsLinked n) then - warning(Error(FSComp.SR.pickleMissingDefinition (i, inMap.Name, ilscope.QualifiedName), range0)) + + // TODO: do not disable + // warning(Error(FSComp.SR.pickleMissingDefinition (i, inMap.Name, ilscope.QualifiedName), range0)) + () + // Note for compiler developers: to get information about which item this index relates to, // enable the conditional in Pickle.p_osgn_ref to refer to the given index number and recompile // an identical copy of the source for the DLL containing the data being unpickled. A message will diff --git a/src/Compiler/TypedTree/TypedTreePickle.fsi b/src/Compiler/TypedTree/TypedTreePickle.fsi deleted file mode 100644 index 3e3910bd4e1..00000000000 --- a/src/Compiler/TypedTree/TypedTreePickle.fsi +++ /dev/null @@ -1,156 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -/// Defines the framework for serializing and de-serializing TAST data structures as binary blobs for the F# metadata format. -module internal FSharp.Compiler.TypedTreePickle - -open FSharp.Compiler.IO -open Internal.Utilities.Library -open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.TypedTree -open FSharp.Compiler.TcGlobals - -/// Represents deserialized data with a dangling set of CCU fixup thunks indexed by name -[] -type PickledDataWithReferences<'RawData> = - { - /// The data that uses a collection of CcuThunks internally - RawData: 'RawData - - /// The assumptions that need to be fixed up - FixupThunks: CcuThunk[] - } - - member Fixup: (CcuReference -> CcuThunk) -> 'RawData - - /// Like Fixup but loader may return None, in which case there is no fixup. - member OptionalFixup: (CcuReference -> CcuThunk option) -> 'RawData - -/// The type of state written to by picklers -type WriterState - -/// A function to pickle a value into a given stateful writer -type pickler<'T> = 'T -> WriterState -> unit - -/// Serialize a byte -val internal p_byte: int -> WriterState -> unit - -/// Serialize a boolean value -val internal p_bool: bool -> WriterState -> unit - -/// Serialize an integer -val internal p_int: int -> WriterState -> unit - -/// Serialize a string -val internal p_string: string -> WriterState -> unit - -/// Serialize a lazy value (eagerly) -val internal p_lazy: pickler<'T> -> InterruptibleLazy<'T> pickler - -/// Serialize a tuple of data -val inline internal p_tup2: pickler<'T1> -> pickler<'T2> -> pickler<'T1 * 'T2> - -/// Serialize a tuple of data -val inline internal p_tup3: pickler<'T1> -> pickler<'T2> -> pickler<'T3> -> pickler<'T1 * 'T2 * 'T3> - -/// Serialize a tuple of data -val inline internal p_tup4: - pickler<'T1> -> pickler<'T2> -> pickler<'T3> -> pickler<'T4> -> pickler<'T1 * 'T2 * 'T3 * 'T4> - -/// Serialize an array of data -val internal p_array: pickler<'T> -> pickler<'T[]> - -/// Serialize a namemap of data -val internal p_namemap: pickler<'T> -> pickler> - -/// Serialize a TAST constant -val internal p_const: pickler - -/// Serialize a TAST value reference -val internal p_vref: string -> pickler - -/// Serialize a TAST type or entity reference -val internal p_tcref: string -> pickler - -/// Serialize a TAST union case reference -val internal p_ucref: pickler - -/// Serialize a TAST expression -val internal p_expr: pickler - -/// Serialize a TAST type -val internal p_ty: pickler - -/// Serialize a TAST description of a compilation unit -val internal pickleCcuInfo: pickler - -/// Serialize an arbitrary object using the given pickler -val pickleObjWithDanglingCcus: - inMem: bool -> file: string -> TcGlobals -> scope: CcuThunk -> pickler<'T> -> 'T -> ByteBuffer * ByteBuffer - -/// The type of state unpicklers read from -type ReaderState - -/// A function to read a value from a given state -type unpickler<'T> = ReaderState -> 'T - -/// Deserialize a byte -val internal u_byte: ReaderState -> int - -/// Deserialize a bool -val internal u_bool: ReaderState -> bool - -/// Deserialize an integer -val internal u_int: ReaderState -> int - -/// Deserialize a string -val internal u_string: ReaderState -> string - -/// Deserialize a lazy value (eagerly) -val internal u_lazy: unpickler<'T> -> unpickler> - -/// Deserialize a tuple -val inline internal u_tup2: unpickler<'T2> -> unpickler<'T3> -> unpickler<'T2 * 'T3> - -/// Deserialize a tuple -val inline internal u_tup3: unpickler<'T2> -> unpickler<'T3> -> unpickler<'T4> -> unpickler<'T2 * 'T3 * 'T4> - -/// Deserialize a tuple -val inline internal u_tup4: - unpickler<'T2> -> unpickler<'T3> -> unpickler<'T4> -> unpickler<'T5> -> unpickler<'T2 * 'T3 * 'T4 * 'T5> - -/// Deserialize an array of values -val internal u_array: unpickler<'T> -> unpickler<'T[]> - -/// Deserialize a namemap -val internal u_namemap: unpickler<'T> -> unpickler> - -/// Deserialize a TAST constant -val internal u_const: unpickler - -/// Deserialize a TAST value reference -val internal u_vref: unpickler - -/// Deserialize a TAST type reference -val internal u_tcref: unpickler - -/// Deserialize a TAST union case reference -val internal u_ucref: unpickler - -/// Deserialize a TAST expression -val internal u_expr: unpickler - -/// Deserialize a TAST type -val internal u_ty: unpickler - -/// Deserialize a TAST description of a compilation unit -val internal unpickleCcuInfo: ReaderState -> PickledCcuInfo - -/// Deserialize an arbitrary object which may have holes referring to other compilation units -val internal unpickleObjWithDanglingCcus: - file: string -> - viewedScope: ILScopeRef -> - ilModule: ILModuleDef option -> - 'T unpickler -> - ReadOnlyByteMemory -> - ReadOnlyByteMemory -> - PickledDataWithReferences<'T> diff --git a/src/Compiler/Utilities/Activity.fs b/src/Compiler/Utilities/Activity.fs index 2d204864f69..54cd1d936b4 100644 --- a/src/Compiler/Utilities/Activity.fs +++ b/src/Compiler/Utilities/Activity.fs @@ -70,6 +70,12 @@ module internal Activity = module Events = let cacheHit = "cacheHit" + let reuseTcResultsCachePrefix = "reuseTcResultsCache" + let reuseTcResultsCachePresent = $"{reuseTcResultsCachePrefix}Present" + let reuseTcResultsCacheAbsent = $"{reuseTcResultsCachePrefix}Absent" + let reuseTcResultsCacheHit = $"{reuseTcResultsCachePrefix}Hit" + let reuseTcResultsCacheMissed = $"{reuseTcResultsCachePrefix}Missed" + type Diagnostics.Activity with member this.RootId = diff --git a/src/Compiler/Utilities/Activity.fsi b/src/Compiler/Utilities/Activity.fsi index 041b2998765..8b72eaa2e39 100644 --- a/src/Compiler/Utilities/Activity.fsi +++ b/src/Compiler/Utilities/Activity.fsi @@ -39,6 +39,11 @@ module internal Activity = module Events = val cacheHit: string + val reuseTcResultsCachePrefix: string + val reuseTcResultsCachePresent: string + val reuseTcResultsCacheAbsent: string + val reuseTcResultsCacheHit: string + val reuseTcResultsCacheMissed: string val startNoTags: name: string -> IDisposable MaybeNull diff --git a/src/Compiler/xlf/FSComp.txt.cs.xlf b/src/Compiler/xlf/FSComp.txt.cs.xlf index 74894da5d02..cca5ceb7c61 100644 --- a/src/Compiler/xlf/FSComp.txt.cs.xlf +++ b/src/Compiler/xlf/FSComp.txt.cs.xlf @@ -987,6 +987,11 @@ Zakázat implicitní generování konstruktorů pomocí reflexe + + Reuse previous typechecking results for faster compilation + Reuse previous typechecking results for faster compilation + + Specify language version such as 'latest' or 'preview'. Upřesněte verzi jazyka, například „latest“ nebo „preview“. diff --git a/src/Compiler/xlf/FSComp.txt.de.xlf b/src/Compiler/xlf/FSComp.txt.de.xlf index 77409615867..3edfdb8abc9 100644 --- a/src/Compiler/xlf/FSComp.txt.de.xlf +++ b/src/Compiler/xlf/FSComp.txt.de.xlf @@ -987,6 +987,11 @@ Deaktivieren der impliziten Generierung von Konstrukten mithilfe von Reflektion + + Reuse previous typechecking results for faster compilation + Reuse previous typechecking results for faster compilation + + Specify language version such as 'latest' or 'preview'. Geben Sie eine Sprachversion wie „latest“ oder „preview“ an. diff --git a/src/Compiler/xlf/FSComp.txt.es.xlf b/src/Compiler/xlf/FSComp.txt.es.xlf index 9f042384d39..b4e9b932a9d 100644 --- a/src/Compiler/xlf/FSComp.txt.es.xlf +++ b/src/Compiler/xlf/FSComp.txt.es.xlf @@ -987,6 +987,11 @@ Deshabilitar la generación implícita de construcciones mediante reflexión + + Reuse previous typechecking results for faster compilation + Reuse previous typechecking results for faster compilation + + Specify language version such as 'latest' or 'preview'. Especifique la versión de idioma, como "latest" o "preview". diff --git a/src/Compiler/xlf/FSComp.txt.fr.xlf b/src/Compiler/xlf/FSComp.txt.fr.xlf index 621286a8e21..53e5b1d0acc 100644 --- a/src/Compiler/xlf/FSComp.txt.fr.xlf +++ b/src/Compiler/xlf/FSComp.txt.fr.xlf @@ -987,6 +987,11 @@ Désactiver la génération implicite de constructions à l’aide de la réflexion + + Reuse previous typechecking results for faster compilation + Reuse previous typechecking results for faster compilation + + Specify language version such as 'latest' or 'preview'. Spécifiez une version de langage telle que 'latest' ou 'preview'. diff --git a/src/Compiler/xlf/FSComp.txt.it.xlf b/src/Compiler/xlf/FSComp.txt.it.xlf index 1d7bdf56aa0..cf1a38248a5 100644 --- a/src/Compiler/xlf/FSComp.txt.it.xlf +++ b/src/Compiler/xlf/FSComp.txt.it.xlf @@ -987,6 +987,11 @@ Disabilitare la generazione implicita di costrutti usando reflection + + Reuse previous typechecking results for faster compilation + Reuse previous typechecking results for faster compilation + + Specify language version such as 'latest' or 'preview'. Specificare la versione della lingua, ad esempio 'latest' o 'preview'. diff --git a/src/Compiler/xlf/FSComp.txt.ja.xlf b/src/Compiler/xlf/FSComp.txt.ja.xlf index c928a51da3e..f12b9e49e74 100644 --- a/src/Compiler/xlf/FSComp.txt.ja.xlf +++ b/src/Compiler/xlf/FSComp.txt.ja.xlf @@ -987,6 +987,11 @@ リフレクションを使用してコンストラクトの暗黙的な生成を無効にする + + Reuse previous typechecking results for faster compilation + Reuse previous typechecking results for faster compilation + + Specify language version such as 'latest' or 'preview'. 'latest' や 'preview' などの言語バージョンを指定します。 diff --git a/src/Compiler/xlf/FSComp.txt.ko.xlf b/src/Compiler/xlf/FSComp.txt.ko.xlf index aaff373fcda..11ac70a8312 100644 --- a/src/Compiler/xlf/FSComp.txt.ko.xlf +++ b/src/Compiler/xlf/FSComp.txt.ko.xlf @@ -987,6 +987,11 @@ 리플렉션을 사용하여 구문의 암시적 생성 사용 안 함 + + Reuse previous typechecking results for faster compilation + Reuse previous typechecking results for faster compilation + + Specify language version such as 'latest' or 'preview'. 'latest' 또는 'preview'와 같이 언어 버전을 지정합니다. diff --git a/src/Compiler/xlf/FSComp.txt.pl.xlf b/src/Compiler/xlf/FSComp.txt.pl.xlf index f886e72e8f8..1c92ec23af4 100644 --- a/src/Compiler/xlf/FSComp.txt.pl.xlf +++ b/src/Compiler/xlf/FSComp.txt.pl.xlf @@ -987,6 +987,11 @@ Wyłącz niejawne generowanie konstrukcji przy użyciu odbicia + + Reuse previous typechecking results for faster compilation + Reuse previous typechecking results for faster compilation + + Specify language version such as 'latest' or 'preview'. Określ wersję językową, taką jak „najnowsza” lub „wersja zapoznawcza”. diff --git a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf index 69082574676..e2f803840e5 100644 --- a/src/Compiler/xlf/FSComp.txt.pt-BR.xlf +++ b/src/Compiler/xlf/FSComp.txt.pt-BR.xlf @@ -987,6 +987,11 @@ Desabilitar a geração implícita de constructos usando reflexão + + Reuse previous typechecking results for faster compilation + Reuse previous typechecking results for faster compilation + + Specify language version such as 'latest' or 'preview'. Especifique a versão do idioma, como 'última versão' ou 'versão prévia'. diff --git a/src/Compiler/xlf/FSComp.txt.ru.xlf b/src/Compiler/xlf/FSComp.txt.ru.xlf index df0d5f9770a..cbc4352d4f0 100644 --- a/src/Compiler/xlf/FSComp.txt.ru.xlf +++ b/src/Compiler/xlf/FSComp.txt.ru.xlf @@ -987,6 +987,11 @@ Отключить неявное создание конструкций с помощью отражения + + Reuse previous typechecking results for faster compilation + Reuse previous typechecking results for faster compilation + + Specify language version such as 'latest' or 'preview'. Укажите версию языка, например "новейшая" или "предварительная версия". diff --git a/src/Compiler/xlf/FSComp.txt.tr.xlf b/src/Compiler/xlf/FSComp.txt.tr.xlf index 77568593137..35f20c3edfd 100644 --- a/src/Compiler/xlf/FSComp.txt.tr.xlf +++ b/src/Compiler/xlf/FSComp.txt.tr.xlf @@ -987,6 +987,11 @@ Yansıma kullanarak yapıların örtük oluşturulmasını devre dışı bırak + + Reuse previous typechecking results for faster compilation + Reuse previous typechecking results for faster compilation + + Specify language version such as 'latest' or 'preview'. 'latest' veya 'preview' gibi dil sürümünü belirtin. diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf index 59532dc06d8..2a3d57f31d8 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hans.xlf @@ -987,6 +987,11 @@ 使用反射禁用隐式构造生成 + + Reuse previous typechecking results for faster compilation + Reuse previous typechecking results for faster compilation + + Specify language version such as 'latest' or 'preview'. 指定语言版本，如 "latest" 或 "preview"。 diff --git a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf index 2274eb373c8..c4585d45108 100644 --- a/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf +++ b/src/Compiler/xlf/FSComp.txt.zh-Hant.xlf @@ -987,6 +987,11 @@ 停用使用反射的隱含產生建構 + + Reuse previous typechecking results for faster compilation + Reuse previous typechecking results for faster compilation + + Specify language version such as 'latest' or 'preview'. 指定語言版本，例如 'latest' 或 'preview'。 diff --git a/src/FSharp.Build/Fsc.fs b/src/FSharp.Build/Fsc.fs index ccbece545d5..9894db58699 100644 --- a/src/FSharp.Build/Fsc.fs +++ b/src/FSharp.Build/Fsc.fs @@ -45,6 +45,7 @@ type public Fsc() as this = let mutable noFramework = false let mutable noInterfaceData = false let mutable noOptimizationData = false + let mutable reuseTcResults = false let mutable optimize: bool = true let mutable otherFlags: string MaybeNull = null let mutable outputAssembly: string MaybeNull = null @@ -165,6 +166,10 @@ type public Fsc() as this = if noOptimizationData then builder.AppendSwitch("--nooptimizationdata") + // ReuseTypecheckingResults + if reuseTcResults then + builder.AppendSwitch("--reusetypecheckingresults") + // BaseAddress builder.AppendSwitchIfNotNull("--baseaddress:", baseAddress) @@ -483,6 +488,11 @@ type public Fsc() as this = with get () = noOptimizationData and set (b) = noOptimizationData <- b + // --reusetypecheckingresults + member _.ReuseTcResults + with get () = reuseTcResults + and set (b) = reuseTcResults <- b + // --optimize member _.Optimize with get () = optimize diff --git a/src/FSharp.Build/Microsoft.FSharp.Targets b/src/FSharp.Build/Microsoft.FSharp.Targets index a1385f6aff2..8cb32d5c7e1 100644 --- a/src/FSharp.Build/Microsoft.FSharp.Targets +++ b/src/FSharp.Build/Microsoft.FSharp.Targets @@ -375,6 +375,7 @@ this file. NoFramework="true" NoInterfaceData="$(NoInterfaceData)" NoOptimizationData="$(NoOptimizationData)" + ReuseTcResults="$(ReuseTypecheckingResults)" Optimize="$(Optimize)" ReflectionFree="$(ReflectionFree)" OtherFlags="$(FscOtherFlags)" diff --git a/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/misc/compiler_help_output.bsl b/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/misc/compiler_help_output.bsl index beafa217722..96734eebb96 100644 --- a/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/misc/compiler_help_output.bsl +++ b/tests/FSharp.Compiler.ComponentTests/CompilerOptions/fsc/misc/compiler_help_output.bsl @@ -116,3 +116,4 @@ Copyright (c) Microsoft Corporation. All Rights Reserved. --highentropyva[+|-] Enable high-entropy ASLR (off by default) --subsystemversion: Specify subsystem version of this assembly --quotations-debug[+|-] Emit debug information in quotations (off by default) +--reusetypecheckingresults Reuse previous typechecking results for faster compilation diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 60b867c7815..b2e8152e8e3 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -264,6 +264,8 @@ + + diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/ReuseTcResults/Activities.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/ReuseTcResults/Activities.fs new file mode 100644 index 00000000000..aa017d8fb2b --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/ReuseTcResults/Activities.fs @@ -0,0 +1,155 @@ +namespace TypeChecks.ReuseTcResultsTests + +open System.Collections.Generic +open System.Diagnostics +open System.IO + +open FSharp.Compiler.Diagnostics +open FSharp.Test +open FSharp.Test.Compiler + +open Xunit + +open TestFramework + + +[] +type Activities() = + + let tempPath = $"{getTemporaryFileName()}.fsx" + + let actualActivities = List() + + let listener = new ActivityListener( + ShouldListenTo = (fun source -> source.Name = ActivityNames.FscSourceName), + Sample = (fun _ -> ActivitySamplingResult.AllData), + ActivityStarted = (fun activity -> + if activity.DisplayName.Contains Activity.Events.reuseTcResultsCachePrefix then + actualActivities.Add activity.DisplayName)) + + do + ActivitySource.AddActivityListener listener + + + [] + let ``Recompilation with changed sources``() = + let expectedActivities = List [ + Activity.Events.reuseTcResultsCacheAbsent + Activity.Events.reuseTcResultsCachePresent + Activity.Events.reuseTcResultsCacheMissed + ] + + File.WriteAllText(tempPath, "42") + + let cUnit = + FsxFromPath tempPath + |> withReuseTcResults + + cUnit + |> compileExisting + |> shouldSucceed + |> ignore + + File.WriteAllText(tempPath, "42") + + cUnit + |> compileExisting + |> shouldSucceed + |> ignore + + Assert.Equal>(expectedActivities, actualActivities) + + [] + let ``Recompilation with changed command line``() = + let expectedActivities = List [ + Activity.Events.reuseTcResultsCacheAbsent + Activity.Events.reuseTcResultsCachePresent + Activity.Events.reuseTcResultsCacheMissed + ] + + File.WriteAllText(tempPath, "42") + + let cUnit = + FsxFromPath tempPath + |> withReuseTcResults + + cUnit + |> compileExisting + |> shouldSucceed + |> ignore + + cUnit + |> withNoOptimizationData // random option + |> compileExisting + |> shouldSucceed + |> ignore + + Assert.Equal>(expectedActivities, actualActivities) + + [] + let ``Recompilation with changed references``() = + let updateFsharpCoreReference() = + let fsharpCoreRef = typeof<_ list>.Assembly.Location + let lastWriteTime = File.GetLastWriteTime fsharpCoreRef + let earlier = lastWriteTime.AddMinutes -1 + + // Have to do this via a copy as otherwise the file is locked on .NET framework. + let fsharpCoreRefTemp = $"{fsharpCoreRef}.temp" + File.Copy(fsharpCoreRef, fsharpCoreRefTemp) + File.SetLastWriteTime(fsharpCoreRefTemp, earlier) + File.Replace(fsharpCoreRefTemp, fsharpCoreRef, null) + + + let expectedActivities = List [ + Activity.Events.reuseTcResultsCacheAbsent + Activity.Events.reuseTcResultsCachePresent + Activity.Events.reuseTcResultsCacheMissed + ] + + File.WriteAllText(tempPath, "42") + + let cUnit = + FsxFromPath tempPath + |> withReuseTcResults + + cUnit + |> compileExisting + |> shouldSucceed + |> ignore + + updateFsharpCoreReference() + + cUnit + |> compileExisting + |> shouldSucceed + |> ignore + + Assert.Equal>(expectedActivities, actualActivities) + + [] + let ``Recompilation with everything same``() = + let expectedActivities = List [ + Activity.Events.reuseTcResultsCacheAbsent + Activity.Events.reuseTcResultsCachePresent + Activity.Events.reuseTcResultsCacheHit + ] + + File.WriteAllText(tempPath, "42") + + let cUnit = + FsxFromPath tempPath + |> withReuseTcResults + |> withOptions [ "--compressmetadata-" ] + |> withOptions [ "--optimize-" ] + + cUnit + |> compileExisting + |> shouldSucceed + |> ignore + + cUnit + |> compileExisting + |> shouldSucceed + |> ignore + + Assert.Equal>(expectedActivities, actualActivities) diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/ReuseTcResults/Recompilation.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/ReuseTcResults/Recompilation.fs new file mode 100644 index 00000000000..afa78a2d0c5 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/TypeChecks/ReuseTcResults/Recompilation.fs @@ -0,0 +1,184 @@ +namespace TypeChecks.ReuseTcResultsTests + +open System.IO + +open FSharp.Test +open FSharp.Test.Compiler + +open Xunit + +open TestFramework + + +[] +type Recompilation() = + + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [] + [ 42">] + [] + [] + + [] + [] + [] + [] + [] + [] + + //[] + //[] + //[] + //[] + //[] + //[] + let ``Recompiles using restored TC info`` (code: string) = + let fileName = getTemporaryFileName() + let tempPath = $"{fileName}.fsx" + + File.WriteAllText(tempPath, code) + + let cUnit = + FsxFromPath tempPath + |> withReuseTcResults + |> withOptions [ "--compressmetadata-" ] + |> withOptions [ "--optimize-" ] + + let expected = + cUnit + |> compileExisting + |> shouldSucceed + |> fun r -> ILChecker.generateIL r.Output.OutputPath.Value [] + + let actual = + cUnit + |> compileExisting + |> shouldSucceed + |> fun r -> ILChecker.generateIL r.Output.OutputPath.Value [] + + let outcome, _msg, _actualIL = + ILChecker.compareIL + fileName + actual + [ expected ] + + Assert.True(outcome) + + [] + let ``Multiple files`` () = + let tempDir = createTemporaryDirectory().FullName + + let code1 = """module M1 +let helloWorld = "hello world!" """ + + let code2 = """module M2 +printfn $"{M1.helloWorld}" """ + + let fileName1 = "File0" + let fileName2 = "File1" + + let tempPath1 = tempDir ++ $"{fileName1}.fs" + let tempPath2 = tempDir ++ $"{fileName2}.fs" + + File.WriteAllText(tempPath1, code1) + File.WriteAllText(tempPath2, code2) + + let cUnit = + FsFromPath tempPath1 + |> withAdditionalSourceFile (SourceCodeFileKind.Create tempPath2) + |> withReuseTcResults + |> withOptions [ "--compressmetadata-" ] + |> withOptions [ "--optimize-" ] + + let expected = + cUnit + |> compileExisting + |> shouldSucceed + |> fun r -> ILChecker.generateIL r.Output.OutputPath.Value [] + + let actual = + cUnit + |> compileExisting + |> shouldSucceed + |> fun r -> ILChecker.generateIL r.Output.OutputPath.Value [] + + let outcome, _msg, _actualIL = + ILChecker.compareIL + fileName1 + actual + [ expected ] + + Assert.True(outcome) + + [] + [] +// [] + let ``Multiple files - partial TC info reuse`` (code1: string) (code2: string) = + let tempDir = createTemporaryDirectory().FullName + + let fileName1 = "File0" + let fileName2 = "File1" + + let tempPath1 = tempDir ++ $"{fileName1}.fs" + let tempPath2 = tempDir ++ $"{fileName2}.fs" + + File.WriteAllText(tempPath1, code1) + File.WriteAllText(tempPath2, code2) + + let cUnit = + FsFromPath tempPath1 + |> withAdditionalSourceFile (SourceCodeFileKind.Create tempPath2) + |> withReuseTcResults + |> withNoInterfaceData + |> withOptions [ "--compressmetadata-" ] + |> withOptions [ "--optimize-" ] + + let expected = + cUnit + |> compileExisting + |> shouldSucceed + |> fun r -> ILChecker.generateIL r.Output.OutputPath.Value [] + + File.WriteAllText(tempPath2, code2) + + let actual = + cUnit + |> compileExisting + |> shouldSucceed + |> fun r -> ILChecker.generateIL r.Output.OutputPath.Value [] + + let outcome, _msg, _actualIL = + ILChecker.compareIL + fileName1 + actual + [ expected ] + + Assert.True(outcome) diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl index 1836a6673c1..1f0e9b2464f 100755 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.debug.bsl @@ -845,6 +845,7 @@ FSharp.Compiler.AbstractIL.IL+ILMethodDefs: Microsoft.FSharp.Collections.FSharpL FSharp.Compiler.AbstractIL.IL+ILMethodDefs: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+ILMethodDef] FindByName(System.String) FSharp.Compiler.AbstractIL.IL+ILMethodDefs: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILMethodDef] TryFindInstanceByNameAndCallingSignature(System.String, ILCallingSignature) FSharp.Compiler.AbstractIL.IL+ILMethodDefs: System.Collections.Generic.IDictionary`2[System.String,Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+ILMethodDef]] CreateDictionary(ILMethodDef[]) +FSharp.Compiler.AbstractIL.IL+ILMethodDefs: Void .ctor(Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,FSharp.Compiler.AbstractIL.IL+ILMethodDef[]]) FSharp.Compiler.AbstractIL.IL+ILMethodImplDef: Boolean Equals(ILMethodImplDef) FSharp.Compiler.AbstractIL.IL+ILMethodImplDef: Boolean Equals(ILMethodImplDef, System.Collections.IEqualityComparer) FSharp.Compiler.AbstractIL.IL+ILMethodImplDef: Boolean Equals(System.Object) @@ -1568,6 +1569,8 @@ FSharp.Compiler.AbstractIL.IL+ILTypeDef: ILSecurityDecls get_SecurityDecls() FSharp.Compiler.AbstractIL.IL+ILTypeDef: ILTypeDef With(Microsoft.FSharp.Core.FSharpOption`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.Reflection.TypeAttributes], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILTypeDefLayout], Microsoft.FSharp.Core.FSharpOption`1[Internal.Utilities.Library.InterruptibleLazy`1[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+InterfaceImpl]]], Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef]], Microsoft.FSharp.Core.FSharpOption`1[Internal.Utilities.Library.InterruptibleLazy`1[Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILType]]], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILMethodDefs], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILTypeDefs], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILFieldDefs], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILMethodImplDefs], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILEventDefs], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILPropertyDefs], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILTypeDefAdditionalFlags], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILAttributesStored], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILSecurityDecls]) FSharp.Compiler.AbstractIL.IL+ILTypeDef: ILTypeDefAccess Access FSharp.Compiler.AbstractIL.IL+ILTypeDef: ILTypeDefAccess get_Access() +FSharp.Compiler.AbstractIL.IL+ILTypeDef: ILTypeDefAdditionalFlags Flags +FSharp.Compiler.AbstractIL.IL+ILTypeDef: ILTypeDefAdditionalFlags get_Flags() FSharp.Compiler.AbstractIL.IL+ILTypeDef: ILTypeDefLayout Layout FSharp.Compiler.AbstractIL.IL+ILTypeDef: ILTypeDefLayout get_Layout() FSharp.Compiler.AbstractIL.IL+ILTypeDef: ILTypeDefs NestedTypes @@ -2830,12 +2833,20 @@ FSharp.Compiler.Diagnostics.ExtendedData+DiagnosticContextInfo: Int32 GetHashCod FSharp.Compiler.Diagnostics.ExtendedData+DiagnosticContextInfo: Int32 Tag FSharp.Compiler.Diagnostics.ExtendedData+DiagnosticContextInfo: Int32 get_Tag() FSharp.Compiler.Diagnostics.ExtendedData+DiagnosticContextInfo: System.String ToString() +FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] DiagnosticId +FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] UrlFormat +FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] get_DiagnosticId() +FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] get_UrlFormat() FSharp.Compiler.Diagnostics.ExtendedData+ExpressionIsAFunctionExtendedData: FSharp.Compiler.Symbols.FSharpType ActualType FSharp.Compiler.Diagnostics.ExtendedData+ExpressionIsAFunctionExtendedData: FSharp.Compiler.Symbols.FSharpType get_ActualType() FSharp.Compiler.Diagnostics.ExtendedData+FieldNotContainedDiagnosticExtendedData: FSharp.Compiler.Symbols.FSharpField ImplementationField FSharp.Compiler.Diagnostics.ExtendedData+FieldNotContainedDiagnosticExtendedData: FSharp.Compiler.Symbols.FSharpField SignatureField FSharp.Compiler.Diagnostics.ExtendedData+FieldNotContainedDiagnosticExtendedData: FSharp.Compiler.Symbols.FSharpField get_ImplementationField() FSharp.Compiler.Diagnostics.ExtendedData+FieldNotContainedDiagnosticExtendedData: FSharp.Compiler.Symbols.FSharpField get_SignatureField() +FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] DiagnosticId +FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] UrlFormat +FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] get_DiagnosticId() +FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] get_UrlFormat() FSharp.Compiler.Diagnostics.ExtendedData+TypeMismatchDiagnosticExtendedData: DiagnosticContextInfo ContextInfo FSharp.Compiler.Diagnostics.ExtendedData+TypeMismatchDiagnosticExtendedData: DiagnosticContextInfo get_ContextInfo() FSharp.Compiler.Diagnostics.ExtendedData+TypeMismatchDiagnosticExtendedData: FSharp.Compiler.Symbols.FSharpDisplayContext DisplayContext @@ -2851,21 +2862,13 @@ FSharp.Compiler.Diagnostics.ExtendedData+ValueNotContainedDiagnosticExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+ArgumentsInSigAndImplMismatchExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+DefinitionsInSigAndImplNotCompatibleAbbreviationsDifferExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+DiagnosticContextInfo +FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+ExpressionIsAFunctionExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+FieldNotContainedDiagnosticExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+IFSharpDiagnosticExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+TypeMismatchDiagnosticExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+ValueNotContainedDiagnosticExtendedData -FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] DiagnosticId -FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] UrlFormat -FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] get_DiagnosticId() -FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] get_UrlFormat() -FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] DiagnosticId -FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] UrlFormat -FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] get_DiagnosticId() -FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] get_UrlFormat() -FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Diagnostics.FSharpDiagnostic Create(FSharp.Compiler.Diagnostics.FSharpDiagnosticSeverity, System.String, Int32, FSharp.Compiler.Text.Range, Microsoft.FSharp.Core.FSharpOption`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.String]) FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Diagnostics.FSharpDiagnosticSeverity Severity FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Diagnostics.FSharpDiagnosticSeverity get_Severity() diff --git a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl index fabaa710607..1f0e9b2464f 100755 --- a/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl +++ b/tests/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.SurfaceArea.netstandard20.release.bsl @@ -845,6 +845,7 @@ FSharp.Compiler.AbstractIL.IL+ILMethodDefs: Microsoft.FSharp.Collections.FSharpL FSharp.Compiler.AbstractIL.IL+ILMethodDefs: Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+ILMethodDef] FindByName(System.String) FSharp.Compiler.AbstractIL.IL+ILMethodDefs: Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILMethodDef] TryFindInstanceByNameAndCallingSignature(System.String, ILCallingSignature) FSharp.Compiler.AbstractIL.IL+ILMethodDefs: System.Collections.Generic.IDictionary`2[System.String,Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+ILMethodDef]] CreateDictionary(ILMethodDef[]) +FSharp.Compiler.AbstractIL.IL+ILMethodDefs: Void .ctor(Microsoft.FSharp.Core.FSharpFunc`2[Microsoft.FSharp.Core.Unit,FSharp.Compiler.AbstractIL.IL+ILMethodDef[]]) FSharp.Compiler.AbstractIL.IL+ILMethodImplDef: Boolean Equals(ILMethodImplDef) FSharp.Compiler.AbstractIL.IL+ILMethodImplDef: Boolean Equals(ILMethodImplDef, System.Collections.IEqualityComparer) FSharp.Compiler.AbstractIL.IL+ILMethodImplDef: Boolean Equals(System.Object) @@ -1568,6 +1569,8 @@ FSharp.Compiler.AbstractIL.IL+ILTypeDef: ILSecurityDecls get_SecurityDecls() FSharp.Compiler.AbstractIL.IL+ILTypeDef: ILTypeDef With(Microsoft.FSharp.Core.FSharpOption`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.Reflection.TypeAttributes], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILTypeDefLayout], Microsoft.FSharp.Core.FSharpOption`1[Internal.Utilities.Library.InterruptibleLazy`1[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+InterfaceImpl]]], Microsoft.FSharp.Core.FSharpOption`1[Microsoft.FSharp.Collections.FSharpList`1[FSharp.Compiler.AbstractIL.IL+ILGenericParameterDef]], Microsoft.FSharp.Core.FSharpOption`1[Internal.Utilities.Library.InterruptibleLazy`1[Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILType]]], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILMethodDefs], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILTypeDefs], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILFieldDefs], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILMethodImplDefs], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILEventDefs], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILPropertyDefs], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILTypeDefAdditionalFlags], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILAttributesStored], Microsoft.FSharp.Core.FSharpOption`1[FSharp.Compiler.AbstractIL.IL+ILSecurityDecls]) FSharp.Compiler.AbstractIL.IL+ILTypeDef: ILTypeDefAccess Access FSharp.Compiler.AbstractIL.IL+ILTypeDef: ILTypeDefAccess get_Access() +FSharp.Compiler.AbstractIL.IL+ILTypeDef: ILTypeDefAdditionalFlags Flags +FSharp.Compiler.AbstractIL.IL+ILTypeDef: ILTypeDefAdditionalFlags get_Flags() FSharp.Compiler.AbstractIL.IL+ILTypeDef: ILTypeDefLayout Layout FSharp.Compiler.AbstractIL.IL+ILTypeDef: ILTypeDefLayout get_Layout() FSharp.Compiler.AbstractIL.IL+ILTypeDef: ILTypeDefs NestedTypes @@ -2830,12 +2833,20 @@ FSharp.Compiler.Diagnostics.ExtendedData+DiagnosticContextInfo: Int32 GetHashCod FSharp.Compiler.Diagnostics.ExtendedData+DiagnosticContextInfo: Int32 Tag FSharp.Compiler.Diagnostics.ExtendedData+DiagnosticContextInfo: Int32 get_Tag() FSharp.Compiler.Diagnostics.ExtendedData+DiagnosticContextInfo: System.String ToString() +FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] DiagnosticId +FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] UrlFormat +FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] get_DiagnosticId() +FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] get_UrlFormat() FSharp.Compiler.Diagnostics.ExtendedData+ExpressionIsAFunctionExtendedData: FSharp.Compiler.Symbols.FSharpType ActualType FSharp.Compiler.Diagnostics.ExtendedData+ExpressionIsAFunctionExtendedData: FSharp.Compiler.Symbols.FSharpType get_ActualType() FSharp.Compiler.Diagnostics.ExtendedData+FieldNotContainedDiagnosticExtendedData: FSharp.Compiler.Symbols.FSharpField ImplementationField FSharp.Compiler.Diagnostics.ExtendedData+FieldNotContainedDiagnosticExtendedData: FSharp.Compiler.Symbols.FSharpField SignatureField FSharp.Compiler.Diagnostics.ExtendedData+FieldNotContainedDiagnosticExtendedData: FSharp.Compiler.Symbols.FSharpField get_ImplementationField() FSharp.Compiler.Diagnostics.ExtendedData+FieldNotContainedDiagnosticExtendedData: FSharp.Compiler.Symbols.FSharpField get_SignatureField() +FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] DiagnosticId +FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] UrlFormat +FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] get_DiagnosticId() +FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] get_UrlFormat() FSharp.Compiler.Diagnostics.ExtendedData+TypeMismatchDiagnosticExtendedData: DiagnosticContextInfo ContextInfo FSharp.Compiler.Diagnostics.ExtendedData+TypeMismatchDiagnosticExtendedData: DiagnosticContextInfo get_ContextInfo() FSharp.Compiler.Diagnostics.ExtendedData+TypeMismatchDiagnosticExtendedData: FSharp.Compiler.Symbols.FSharpDisplayContext DisplayContext @@ -2851,22 +2862,13 @@ FSharp.Compiler.Diagnostics.ExtendedData+ValueNotContainedDiagnosticExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+ArgumentsInSigAndImplMismatchExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+DefinitionsInSigAndImplNotCompatibleAbbreviationsDifferExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+DiagnosticContextInfo +FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+ExpressionIsAFunctionExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+FieldNotContainedDiagnosticExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+IFSharpDiagnosticExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+TypeMismatchDiagnosticExtendedData FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+ValueNotContainedDiagnosticExtendedData -FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] DiagnosticId -FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] UrlFormat -FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] get_DiagnosticId() -FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] get_UrlFormat() -FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+ObsoleteDiagnosticExtendedData -FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] DiagnosticId -FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] UrlFormat -FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] get_DiagnosticId() -FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData: Microsoft.FSharp.Core.FSharpOption`1[System.String] get_UrlFormat() -FSharp.Compiler.Diagnostics.ExtendedData: FSharp.Compiler.Diagnostics.ExtendedData+ExperimentalExtendedData FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Diagnostics.FSharpDiagnostic Create(FSharp.Compiler.Diagnostics.FSharpDiagnosticSeverity, System.String, Int32, FSharp.Compiler.Text.Range, Microsoft.FSharp.Core.FSharpOption`1[System.String], Microsoft.FSharp.Core.FSharpOption`1[System.String]) FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Diagnostics.FSharpDiagnosticSeverity Severity FSharp.Compiler.Diagnostics.FSharpDiagnostic: FSharp.Compiler.Diagnostics.FSharpDiagnosticSeverity get_Severity() diff --git a/tests/FSharp.Compiler.Service.Tests/expected-help-output.bsl b/tests/FSharp.Compiler.Service.Tests/expected-help-output.bsl index 318bb051e59..71344358be9 100644 --- a/tests/FSharp.Compiler.Service.Tests/expected-help-output.bsl +++ b/tests/FSharp.Compiler.Service.Tests/expected-help-output.bsl @@ -183,3 +183,5 @@ assembly --quotations-debug[+|-] Emit debug information in quotations (off by default) +--reusetypecheckingresults Reuse previous typechecking results + for faster compilation diff --git a/tests/FSharp.Test.Utilities/Compiler.fs b/tests/FSharp.Test.Utilities/Compiler.fs index c6346cb30f2..1b1679b763a 100644 --- a/tests/FSharp.Test.Utilities/Compiler.fs +++ b/tests/FSharp.Test.Utilities/Compiler.fs @@ -686,6 +686,9 @@ module rec Compiler = let withNoInterfaceData (cUnit: CompilationUnit) : CompilationUnit = withOptionsHelper [ "--nointerfacedata" ] "withNoInterfaceData is only supported for F#" cUnit + let withReuseTcResults (cUnit: CompilationUnit) : CompilationUnit = + withOptionsHelper [ "--reusetypecheckingresults" ] "reusetypecheckingresults is only supported for F#" cUnit + //--refonly[+|-] let withRefOnly (cUnit: CompilationUnit) : CompilationUnit = withOptionsHelper [ $"--refonly+" ] "withRefOnly is only supported for F#" cUnit @@ -936,6 +939,34 @@ module rec Compiler = | CS cs -> compileCSharp cs | _ -> failwith "TODO" + let compileExisting (cUnit: CompilationUnit) : CompilationResult = + match cUnit with + | FS fs -> + let sourceFilePath = fs.Source.GetSourceFileName + if (not <| File.Exists sourceFilePath) then + failwith "File doesn't exist. Create it to use this function." + + let outputFilePath = Path.ChangeExtension(sourceFilePath, ".dll") + let err, _, _ = rawCompile outputFilePath false fs.Options TargetFramework.Current (fs.Source :: fs.AdditionalSources) + let diagnostics = err |> fromFSharpDiagnostic + + let result = { + OutputPath = Some outputFilePath + Dependencies = [] + Adjust = 0 + PerFileErrors = diagnostics + Diagnostics = diagnostics |> List.map snd + Output = None + Compilation = cUnit + } + + if err.Length = 0 then + CompilationResult.Success result + else + CompilationResult.Failure result + + | _ -> failwith "TODO" + let private getAssemblyInBytes (result: CompilationResult) = match result with | CompilationResult.Success output -> diff --git a/tests/FSharp.Test.Utilities/ILChecker.fs b/tests/FSharp.Test.Utilities/ILChecker.fs index 69b5d6c6c6a..904061b8fb7 100644 --- a/tests/FSharp.Test.Utilities/ILChecker.fs +++ b/tests/FSharp.Test.Utilities/ILChecker.fs @@ -113,14 +113,14 @@ module ILChecker = ilFilePath - let private generateIL (dllFilePath: string) ildasmArgs = + let generateIL (dllFilePath: string) ildasmArgs = let assemblyName = Some (Path.GetFileNameWithoutExtension dllFilePath) let ilFilePath = generateIlFile dllFilePath ildasmArgs let normalizedText = normalizeILText assemblyName (File.ReadAllText(ilFilePath)) File.WriteAllText(ilFilePath, normalizedText) normalizedText - let private compareIL assemblyName (actualIL: string) expectedIL = + let compareIL assemblyName (actualIL: string) expectedIL = let mutable errorMsgOpt = None