@@ -1047,6 +1047,10 @@ type TcState =
10471047: OpenDeclaration list
10481048 }
10491049
1050+ member x.TcsRootSigs = x.tcsRootSigs
1051+
1052+ member x.TcsRootImpls = x.tcsRootImpls
1053+
10501054 member x.TcEnvFromSignatures = x.tcsTcSigEnv
10511055
10521056 member x.TcEnvFromImpls = x.tcsTcImplEnv
@@ -1070,6 +1074,13 @@ type TcState =
10701074 { x with
10711075 tcsCreatesGeneratedProvidedTypes = y
10721076 }
1077+
1078+ member x.WithStuff tcEnv rootSigs creates : TcState =
1079+ { x with
1080+ tcsTcSigEnv = tcEnv
1081+ tcsRootSigs = rootSigs
1082+ tcsCreatesGeneratedProvidedTypes = creates
1083+ }
10731084
10741085type State = TcState * bool
10751086
@@ -1814,215 +1825,6 @@ let mutable CheckMultipleInputsInParallel2 : CheckArgs -> (PartialResult list *
18141825 =
18151826 CheckMultipleInputsInParallel
18161827
1817- type WorkInput =
1818- {
1819- FileIndex : int
1820- ParsedInput : ParsedInput
1821- Logger : DiagnosticsLogger
1822- }
1823-
1824- /// Use parallel checking of implementation files that have signature files
1825- let CheckMultipleInputsInParallel3
1826- (( ctok : CompilationThreadToken ,
1827- checkForErrors : unit -> bool ,
1828- tcConfig : TcConfig ,
1829- tcImports : TcImports ,
1830- tcGlobals : TcGlobals ,
1831- prefixPathOpt ,
1832- tcState ,
1833- eagerFormat ,
1834- inputs ): CompilationThreadToken * ( unit -> bool ) * TcConfig * TcImports * TcGlobals * LongIdent option * TcState * ( PhasedDiagnostic -> PhasedDiagnostic ) * ParsedInput list )
1835- : PartialResult list * TcState =
1836-
1837- let _ = ctok // TODO Use
1838- let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger
1839-
1840- // In the first linear part of parallel checking, we use a 'checkForErrors' that checks either for errors
1841- // somewhere in the files processed prior to each one, or in the processing of this particular file.
1842- let priorErrors = checkForErrors ()
1843- let amap = tcImports.GetImportMap()
1844- let conditionalDefines =
1845- if tcConfig.noConditionalErasure then
1846- None
1847- else
1848- Some tcConfig.conditionalDefines
1849-
1850- let processFile
1851- ( currentTcState : TcState )
1852- (( input , logger ) : ParsedInput * DiagnosticsLogger )
1853- : State -> PartialResult * State =
1854- cancellable {
1855- use _ = UseDiagnosticsLogger logger
1856- // Is it OK that we don't update 'priorErrors' after processing batches?
1857- let checkForErrors2 () = priorErrors || ( logger.ErrorCount > 0 )
1858-
1859- // this is taken mostly from CheckOneInputAux, the case where the impl has no signature file
1860- let file =
1861- match input with
1862- | ParsedInput.ImplFile file -> file
1863- | ParsedInput.SigFile _ -> failwith " not expecting a signature file for now"
1864-
1865- let tcSink = TcResultsSink.NoSink
1866-
1867- // Typecheck the implementation file
1868- let! topAttrs , implFile , tcEnvAtEnd , createsGeneratedProvidedTypes =
1869- CheckOneImplFile(
1870- tcGlobals,
1871- amap,
1872- currentTcState.tcsCcu,
1873- currentTcState.tcsImplicitOpenDeclarations,
1874- checkForErrors2,
1875- conditionalDefines,
1876- TcResultsSink.NoSink,
1877- tcConfig.internalTestSpanStackReferring,
1878- currentTcState.tcsTcImplEnv,
1879- None,
1880- file
1881- )
1882-
1883- return
1884- ( fun ( state : State ) ->
1885- let tcState , _priorErrors = state
1886- let tcState =
1887- { tcState with
1888- tcsCreatesGeneratedProvidedTypes =
1889- tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes
1890- }
1891-
1892- let ccuSigForFile , updatedTcState =
1893- let results =
1894- tcGlobals,
1895- amap,
1896- false ,
1897- prefixPathOpt,
1898- tcSink,
1899- tcState.tcsTcImplEnv,
1900- input.QualifiedName,
1901- implFile.Signature
1902-
1903- AddCheckResultsToTcState results tcState
1904-
1905- let partialResult : PartialResult = tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile
1906- let hasErrors = logger.ErrorCount > 0
1907- let priorOrCurrentErrors = priorErrors || hasErrors
1908- let state : State = updatedTcState, priorOrCurrentErrors
1909-
1910- partialResult, state
1911- )
1912- }
1913- |> Cancellable.runWithoutCancellation
1914-
1915-
1916- // We create one CapturingDiagnosticLogger for each file we are processing and
1917- // ensure the diagnostics are presented in deterministic order.
1918- //
1919- // eagerFormat is used to format diagnostics as they are emitted, just as they would be in the command-line
1920- // compiler. This is necessary because some formatting of diagnostics is dependent on the
1921- // type inference state at precisely the time the diagnostic is emitted.
1922- // TODO Does this mean we can't have more than one TcState with different contents?
1923- // How does the formatting code know the state of type-checking/type inference? We don't pass it to the formatter directly
1924- UseMultipleDiagnosticLoggers ( inputs, diagnosticsLogger, Some eagerFormat) ( fun inputsWithLoggers ->
1925-
1926- // Equip loggers to locally filter w.r.t. scope pragmas in each input
1927- let inputsWithLoggers : ( ParsedInput * DiagnosticsLogger )[] =
1928- inputsWithLoggers
1929- |> Seq.map ( fun ( input , oldLogger ) ->
1930- let logger = DiagnosticsLoggerForInput( tcConfig, input, oldLogger)
1931- input, logger)
1932- |> Seq.toArray
1933-
1934- // In the first linear part of parallel checking, we use a 'checkForErrors' that checks either for errors
1935- // somewhere in the files processed prior to each one, or in the processing of this particular file.
1936- let priorErrors = checkForErrors ()
1937-
1938- // Grand experiment
1939- // This code assumes the following file structure
1940- // A.fs
1941- // B1.fs (uses A)
1942- // B2.fs (uses A, B1)
1943- // C1.fs (uses A)
1944- // C2.fs (uses A, C1)
1945- // D.fs (uses A, B2, C2)
1946- assert ( inputsWithLoggers.Length = 6 )
1947-
1948- let fileDependencies =
1949- [|
1950- Set.empty
1951- set [ 0 ]
1952- set [ 0 ; 1 ]
1953- set [ 0 ]
1954- set [ 0 ; 3 ]
1955- set [ 0 ; 2 ; 4 ]
1956- |]
1957-
1958- let partialResults , ( state : State ) =
1959- let lastIndex = inputsWithLoggers.Length - 1
1960-
1961- // This function will type check all the files where it knows all the dependent file have already been seen.
1962- // The `freeFiles` are a set of file indexes that have been type checked in a previous run.
1963- // `processedFiles` stores the result of a typed checked file in a mutable fashion.
1964- let rec visit ( state : State ) ( freeFiles : Set < int >) ( processedFiles : PartialResult array ): PartialResult array * State =
1965- let ( currentTcState , currentPriorErrors ) = state
1966- // Find files that still needs processing.
1967- let unprocessedFiles = freeFiles |> Set.difference ( set [| 0 .. lastIndex |])
1968-
1969- if Set.isEmpty unprocessedFiles then
1970- // All done
1971- processedFiles, state
1972- else
1973- // What files can we type check from the files that are left to type check.
1974- let nextFreeIndexes : ( int * ( ParsedInput * DiagnosticsLogger ))[] =
1975- unprocessedFiles
1976- |> Seq.choose ( fun fileIndex ->
1977- let isFreeFile =
1978- Seq.forall ( fun idx -> Set.contains idx freeFiles) fileDependencies.[ fileIndex]
1979-
1980- if isFreeFile then
1981- Some( fileIndex, inputsWithLoggers.[ fileIndex])
1982- else
1983- None)
1984- |> Seq.toArray
1985-
1986- let go ( fileIndex : int , ( input , logger )) : State -> int * ( PartialResult * State ) =
1987- let r = processFile currentTcState ( input, logger)
1988- fun state ->
1989- fileIndex, r state
1990-
1991- // The next batch of files we can process in parallel
1992- let next =
1993- nextFreeIndexes
1994- |> ArrayParallel.map go
1995- |> fun results ->
1996- (( currentTcState, currentPriorErrors), results)
1997- ||> Array.fold ( fun state result ->
1998- // the `result` callback ensure that the TcState is synced correctly after a batch of file has been type checked in parallel.
1999- // I believe this bit cannot be done in parallel, yet the order in which we fold the state does not matter.
2000- let fileIndex , ( partialResult , state ) = result state
2001- // Yikes!
2002- // Nah, it's okay.
2003- processedFiles[ fileIndex] <- partialResult
2004- state
2005- )
2006-
2007- // The next set of free files are the previous ones + the files we just type checked.
2008- let nextFreeIndexes =
2009- seq {
2010- yield ! freeFiles
2011- yield ! ( Seq.map fst nextFreeIndexes)
2012- }
2013- |> Set.ofSeq
2014-
2015- // Next round!
2016- visit next nextFreeIndexes processedFiles
2017-
2018- visit ( tcState, priorErrors) Set.empty ( Array.zeroCreate inputsWithLoggers.Length)
2019-
2020- let tcState , _errors = state
2021- let partialResults = partialResults |> Array.toList
2022- partialResults, tcState
2023- )
2024-
2025-
20261828let CheckClosedInputSet ( ctok , checkForErrors , tcConfig : TcConfig , tcImports , tcGlobals , prefixPathOpt , tcState , eagerFormat , inputs ) =
20271829 // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions
20281830 let results , tcState =
0 commit comments