Skip to content

Commit

Permalink
changes
Browse files Browse the repository at this point in the history
  • Loading branch information
@safesparrow
safesparrow committed Oct 29, 2022
1 parent 10447af commit b2c265b
Show file tree
Hide file tree
Showing 7 changed files with 250 additions and 114 deletions.
160 changes: 83 additions & 77 deletions src/Compiler/Driver/ParseAndCheckInputs.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,6 +8,7 @@ open System.Diagnostics
open System.IO
open System.Collections.Generic

open System.Threading
open Internal.Utilities.Collections
open Internal.Utilities.Library
open Internal.Utilities.Library.Extras
Expand Down Expand Up @@ -1558,21 +1559,96 @@ type WorkInput =

/// Use parallel checking of implementation files that have signature files
let CheckMultipleInputsInParallel2
(
ctok,
checkForErrors,
((ctok : CancellationToken,
checkForErrors: unit -> bool,
tcConfig: TcConfig,
tcImports: TcImports,
tcGlobals,
tcGlobals: TcGlobals,
prefixPathOpt,
tcState,
eagerFormat,
inputs
) : PartialResult list * TcState =
inputs): CancellationToken * (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcState * (PhasedDiagnostic -> PhasedDiagnostic) * ParsedInput list)
: PartialResult list * TcState =

let _ = ctok // TODO Use
let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger

// In the first linear part of parallel checking, we use a 'checkForErrors' that checks either for errors
// somewhere in the files processed prior to each one, or in the processing of this particular file.
let priorErrors = checkForErrors ()
let amap = tcImports.GetImportMap()
let conditionalDefines =
if tcConfig.noConditionalErasure then
None
else
Some tcConfig.conditionalDefines

let processFile
(currentTcState : TcState)
((input, logger) : ParsedInput * DiagnosticsLogger)
: State -> PartialResult * State =
cancellable {
use _ = UseDiagnosticsLogger logger
// Is it OK that we don't update 'priorErrors' after processing batches?
let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0)

// this is taken mostly from CheckOneInputAux, the case where the impl has no signature file
let file =
match input with
| ParsedInput.ImplFile file -> file
| ParsedInput.SigFile _ -> failwith "not expecting a signature file for now"

let tcSink = TcResultsSink.NoSink

// Typecheck the implementation file
let! topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes =
CheckOneImplFile(
tcGlobals,
amap,
currentTcState.tcsCcu,
currentTcState.tcsImplicitOpenDeclarations,
checkForErrors2,
conditionalDefines,
TcResultsSink.NoSink,
tcConfig.internalTestSpanStackReferring,
currentTcState.tcsTcImplEnv,
None,
file
)

return
(fun (state : State) ->
let tcState, _priorErrors = state
let tcState =
{ tcState with
tcsCreatesGeneratedProvidedTypes =
tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes
}

let ccuSigForFile, updatedTcState =
let results =
tcGlobals,
amap,
false,
prefixPathOpt,
tcSink,
tcState.tcsTcImplEnv,
input.QualifiedName,
implFile.Signature

AddCheckResultsToTcState results tcState

let partialResult : PartialResult = tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile
let hasErrors = logger.ErrorCount > 0
let priorOrCurrentErrors = priorErrors || hasErrors
let state : State = updatedTcState, priorOrCurrentErrors

partialResult, state
)
}
|> Cancellable.runWithoutCancellation


// We create one CapturingDiagnosticLogger for each file we are processing and
// ensure the diagnostics are presented in deterministic order.
//
Expand Down Expand Up @@ -1617,13 +1693,6 @@ let CheckMultipleInputsInParallel2

let partialResults, (state : State) =
let lastIndex = inputsWithLoggers.Length - 1
let amap = tcImports.GetImportMap()

let conditionalDefines =
if tcConfig.noConditionalErasure then
None
else
Some tcConfig.conditionalDefines

// This function will type check all the files where it knows all the dependent file have already been seen.
// The `freeFiles` are a set of file indexes that have been type checked in a previous run.
Expand All @@ -1649,72 +1718,9 @@ let CheckMultipleInputsInParallel2
else
None)
|> Seq.toArray

let processFile ((input, logger) : ParsedInput * _)
: State -> PartialResult * State =
cancellable {
use _ = UseDiagnosticsLogger logger
// Is it OK that we don't update 'priorErrors' after processing batches?
let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0)

// this is taken mostly from CheckOneInputAux, the case where the impl has no signature file
let file =
match input with
| ParsedInput.ImplFile file -> file
| ParsedInput.SigFile _ -> failwith "not expecting a signature file for now"

let tcSink = TcResultsSink.NoSink

// Typecheck the implementation file
let! topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes =
CheckOneImplFile(
tcGlobals,
amap,
currentTcState.tcsCcu,
currentTcState.tcsImplicitOpenDeclarations,
checkForErrors2,
conditionalDefines,
TcResultsSink.NoSink,
tcConfig.internalTestSpanStackReferring,
currentTcState.tcsTcImplEnv,
None,
file
)

return
(fun (state : State) ->
let tcState, _priorErrors = state
let tcState =
{ tcState with
tcsCreatesGeneratedProvidedTypes =
tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes
}

let ccuSigForFile, updatedTcState =
let results =
tcGlobals,
amap,
false,
prefixPathOpt,
tcSink,
tcState.tcsTcImplEnv,
input.QualifiedName,
implFile.Signature

AddCheckResultsToTcState results tcState

let partialResult : PartialResult = tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile
let hasErrors = logger.ErrorCount > 0
let priorOrCurrentErrors = priorErrors || hasErrors
let state : State = updatedTcState, priorOrCurrentErrors

partialResult, state
)
}
|> Cancellable.runWithoutCancellation

let go (fileIndex : int, (input, logger)) : State -> int * (PartialResult * State) =
let r = processFile (input, logger)
let r = processFile currentTcState (input, logger)
fun state ->
fileIndex, r state

Expand Down
8 changes: 4 additions & 4 deletions tests/FSharp.Compiler.Service.Tests2/FileInfoGathering.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,16 +14,16 @@ let internal gatherBackingInfo (files : SourceFiles) : Files =
let fsiBacked =
match f.AST with
| ParsedInput.SigFile _ ->
seenSigFiles.Add f.Name |> ignore
// TODO Use QualifiedNameOfFile
seenSigFiles.Add f.AST.FileName |> ignore
false
| ParsedInput.ImplFile _ ->
let fsiName = System.IO.Path.ChangeExtension(f.Name, "fsi")
let fsiName = System.IO.Path.ChangeExtension(f.QualifiedName, "fsi")
let fsiBacked = seenSigFiles.Contains fsiName
fsiBacked
{
Name = f.Name
Idx = FileIdx.make i
Code = f.Code
Code = "no code here" // TODO
AST = f.AST
FsiBacked = fsiBacked
}
Expand Down
19 changes: 13 additions & 6 deletions tests/FSharp.Compiler.Service.Tests2/GraphProcessing.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -75,13 +75,13 @@ let combineResults
state

// TODO Could be replaced with a simpler recursive approach with memoised per-item results
let processGraph<'Item, 'State, 'Result when 'Item : equality>
let processGraph<'Item, 'State, 'Result, 'FinalFileResult when 'Item : equality>
(graph : Graph<'Item>)
(doWork : 'Item -> 'State -> 'Result)
(folder : 'State -> 'Result -> 'State)
(folder : 'State -> 'Result -> 'FinalFileResult * 'State)
(emptyState : 'State)
(parallelism : int)
: 'State
: 'FinalFileResult[] * 'State
=
let transitiveDeps = graph |> Graph.transitive
let dependants = graph |> Graph.reverse
Expand Down Expand Up @@ -117,6 +117,9 @@ let processGraph<'Item, 'State, 'Result when 'Item : equality>
=
let deps = lookupMany node.Info.Deps
let transitiveDeps = lookupMany node.Info.TransitiveDeps
let folder state result =
folder state result
|> snd
let inputState = combineResults emptyState deps transitiveDeps folder
let singleRes = doWork node.Info.Item inputState
let state = folder inputState singleRes
Expand All @@ -138,7 +141,6 @@ let processGraph<'Item, 'State, 'Result when 'Item : equality>
)
unblocked


use cts = new CancellationTokenSource()

Parallel.processInParallel
Expand All @@ -149,5 +151,10 @@ let processGraph<'Item, 'State, 'Result when 'Item : equality>
cts.Token

let nodesArray = nodes.Values |> Seq.toArray
let state = combineResults emptyState nodesArray nodesArray folder
state
let x: 'FinalFileResult[] * 'State =
nodesArray
|> Array.fold (fun (fileResults, state) item ->
let fileResult, state = folder state (item.Result.Value |> snd)
Array.append fileResults [|fileResult|], state
) ([||], emptyState)
x
84 changes: 69 additions & 15 deletions tests/FSharp.Compiler.Service.Tests2/ParallelTypeChecking.fs
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,18 @@
module FSharp.Compiler.Service.Tests.ParallelTypeChecking

open System.Threading
open FSharp.Compiler
open FSharp.Compiler.CheckBasics
open FSharp.Compiler.CheckDeclarations
open FSharp.Compiler.CompilerConfig
open FSharp.Compiler.CompilerImports
open FSharp.Compiler.DiagnosticsLogger
open FSharp.Compiler.ParseAndCheckInputs
open FSharp.Compiler.Service.Tests.Graph
open FSharp.Compiler.Service.Tests.Types
open FSharp.Compiler.Syntax
open FSharp.Compiler.TcGlobals
open FSharp.Compiler.TypedTree

type FileGraph = Graph<File>

Expand All @@ -11,30 +22,73 @@ let calcFileGraph (files : SourceFiles) : FileGraph =

// TODO Use real things
type State = string
type SingleResult = int
type FinalFileResult = string
type SingleResult = State -> FinalFileResult * State

// TODO Use the real thing
let typeCheckFile (file : File) (state : State) : SingleResult
=
file.Idx.Idx
fun (state : State) ->
let res = file.Idx.Idx
res.ToString(), $"{state}+{res}"

// TODO Use the real thing
let folder (state : State) (result : SingleResult) =
$"{state}+{result}"
let folder (state : State) (result : SingleResult): FinalFileResult * State =
result state

module internal Real =

type State = TcState * bool
type SingleResult = State -> FinalFileResult * State

// TODO Use the real thing
let typeCheckFile (file : File) (state : State) : SingleResult
=
fun (state : State) ->
let res = file.Idx.Idx
res.ToString(), $"{state}+{res}"

type PartialResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType

/// Use parallel checking of implementation files that have signature files
let CheckMultipleInputsInParallel2
((ctok,
checkForErrors,
tcConfig: TcConfig,
tcImports: TcImports,
tcGlobals,
prefixPathOpt,
tcState,
eagerFormat,
inputs): CancellationToken * (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcState * (PhasedDiagnostic -> PhasedDiagnostic) * ParsedInput list) : PartialResult list * TcState =
failwith ""



// TODO We probably need to return partial results as well
let typeCheckGraph (graph : FileGraph) : State =

let folder (state : State) (result : SingleResult): FinalFileResult * State =
result state


let typeCheckGraph (graph : FileGraph) : FinalFileResult[] * State =
let parallelism = 4 // cpu count?
GraphProcessing.processGraph
graph
typeCheckFile
folder
""
parallelism

let typeCheckGraph2 (graph : FileGraph) : FinalFileResult[] * State =
let parallelism = 4 // cpu count?
let state =
GraphProcessing.processGraph
graph
typeCheckFile
folder
""
parallelism
state
GraphProcessing.processGraph
graph
typeCheckFile
folder
""
parallelism

let typeCheck (files : SourceFiles) : State =
let typeCheck (files : SourceFiles) : FinalFileResult[] * State =
let graph = calcFileGraph files
let state = typeCheckGraph graph
state

0 comments on commit b2c265b

Please sign in to comment.