Skip to content

Commit b2c265b

Browse files
safesparrowsafesparrow
committed
changes
1 parent 10447af commit b2c265b

7 files changed

Lines changed: 250 additions & 114 deletions

File tree

‎src/Compiler/Driver/ParseAndCheckInputs.fs‎

Lines changed: 83 additions & 77 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@ open System.Diagnostics
88
open System.IO
99
open System.Collections.Generic
1010

11+
open System.Threading
1112
open Internal.Utilities.Collections
1213
open Internal.Utilities.Library
1314
open Internal.Utilities.Library.Extras
@@ -1558,21 +1559,96 @@ type WorkInput =
15581559

15591560
/// Use parallel checking of implementation files that have signature files
15601561
let CheckMultipleInputsInParallel2
1561-
(
1562-
ctok,
1563-
checkForErrors,
1562+
((ctok : CancellationToken,
1563+
checkForErrors: unit -> bool,
15641564
tcConfig: TcConfig,
15651565
tcImports: TcImports,
1566-
tcGlobals,
1566+
tcGlobals: TcGlobals,
15671567
prefixPathOpt,
15681568
tcState,
15691569
eagerFormat,
1570-
inputs
1571-
) : PartialResult list * TcState =
1570+
inputs): CancellationToken * (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcState * (PhasedDiagnostic -> PhasedDiagnostic) * ParsedInput list)
1571+
: PartialResult list * TcState =
15721572

15731573
let _ = ctok // TODO Use
15741574
let diagnosticsLogger = DiagnosticsThreadStatics.DiagnosticsLogger
15751575

1576+
// In the first linear part of parallel checking, we use a 'checkForErrors' that checks either for errors
1577+
// somewhere in the files processed prior to each one, or in the processing of this particular file.
1578+
let priorErrors = checkForErrors ()
1579+
let amap = tcImports.GetImportMap()
1580+
let conditionalDefines =
1581+
if tcConfig.noConditionalErasure then
1582+
None
1583+
else
1584+
Some tcConfig.conditionalDefines
1585+
1586+
let processFile
1587+
(currentTcState : TcState)
1588+
((input, logger) : ParsedInput * DiagnosticsLogger)
1589+
: State -> PartialResult * State =
1590+
cancellable {
1591+
use _ = UseDiagnosticsLogger logger
1592+
// Is it OK that we don't update 'priorErrors' after processing batches?
1593+
let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0)
1594+
1595+
// this is taken mostly from CheckOneInputAux, the case where the impl has no signature file
1596+
let file =
1597+
match input with
1598+
| ParsedInput.ImplFile file -> file
1599+
| ParsedInput.SigFile _ -> failwith "not expecting a signature file for now"
1600+
1601+
let tcSink = TcResultsSink.NoSink
1602+
1603+
// Typecheck the implementation file
1604+
let! topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes =
1605+
CheckOneImplFile(
1606+
tcGlobals,
1607+
amap,
1608+
currentTcState.tcsCcu,
1609+
currentTcState.tcsImplicitOpenDeclarations,
1610+
checkForErrors2,
1611+
conditionalDefines,
1612+
TcResultsSink.NoSink,
1613+
tcConfig.internalTestSpanStackReferring,
1614+
currentTcState.tcsTcImplEnv,
1615+
None,
1616+
file
1617+
)
1618+
1619+
return
1620+
(fun (state : State) ->
1621+
let tcState, _priorErrors = state
1622+
let tcState =
1623+
{ tcState with
1624+
tcsCreatesGeneratedProvidedTypes =
1625+
tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes
1626+
}
1627+
1628+
let ccuSigForFile, updatedTcState =
1629+
let results =
1630+
tcGlobals,
1631+
amap,
1632+
false,
1633+
prefixPathOpt,
1634+
tcSink,
1635+
tcState.tcsTcImplEnv,
1636+
input.QualifiedName,
1637+
implFile.Signature
1638+
1639+
AddCheckResultsToTcState results tcState
1640+
1641+
let partialResult : PartialResult = tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile
1642+
let hasErrors = logger.ErrorCount > 0
1643+
let priorOrCurrentErrors = priorErrors || hasErrors
1644+
let state : State = updatedTcState, priorOrCurrentErrors
1645+
1646+
partialResult, state
1647+
)
1648+
}
1649+
|> Cancellable.runWithoutCancellation
1650+
1651+
15761652
// We create one CapturingDiagnosticLogger for each file we are processing and
15771653
// ensure the diagnostics are presented in deterministic order.
15781654
//
@@ -1617,13 +1693,6 @@ let CheckMultipleInputsInParallel2
16171693

16181694
let partialResults, (state : State) =
16191695
let lastIndex = inputsWithLoggers.Length - 1
1620-
let amap = tcImports.GetImportMap()
1621-
1622-
let conditionalDefines =
1623-
if tcConfig.noConditionalErasure then
1624-
None
1625-
else
1626-
Some tcConfig.conditionalDefines
16271696

16281697
// This function will type check all the files where it knows all the dependent file have already been seen.
16291698
// The `freeFiles` are a set of file indexes that have been type checked in a previous run.
@@ -1649,72 +1718,9 @@ let CheckMultipleInputsInParallel2
16491718
else
16501719
None)
16511720
|> Seq.toArray
1652-
1653-
let processFile ((input, logger) : ParsedInput * _)
1654-
: State -> PartialResult * State =
1655-
cancellable {
1656-
use _ = UseDiagnosticsLogger logger
1657-
// Is it OK that we don't update 'priorErrors' after processing batches?
1658-
let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0)
1659-
1660-
// this is taken mostly from CheckOneInputAux, the case where the impl has no signature file
1661-
let file =
1662-
match input with
1663-
| ParsedInput.ImplFile file -> file
1664-
| ParsedInput.SigFile _ -> failwith "not expecting a signature file for now"
1665-
1666-
let tcSink = TcResultsSink.NoSink
1667-
1668-
// Typecheck the implementation file
1669-
let! topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes =
1670-
CheckOneImplFile(
1671-
tcGlobals,
1672-
amap,
1673-
currentTcState.tcsCcu,
1674-
currentTcState.tcsImplicitOpenDeclarations,
1675-
checkForErrors2,
1676-
conditionalDefines,
1677-
TcResultsSink.NoSink,
1678-
tcConfig.internalTestSpanStackReferring,
1679-
currentTcState.tcsTcImplEnv,
1680-
None,
1681-
file
1682-
)
1683-
1684-
return
1685-
(fun (state : State) ->
1686-
let tcState, _priorErrors = state
1687-
let tcState =
1688-
{ tcState with
1689-
tcsCreatesGeneratedProvidedTypes =
1690-
tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes
1691-
}
1692-
1693-
let ccuSigForFile, updatedTcState =
1694-
let results =
1695-
tcGlobals,
1696-
amap,
1697-
false,
1698-
prefixPathOpt,
1699-
tcSink,
1700-
tcState.tcsTcImplEnv,
1701-
input.QualifiedName,
1702-
implFile.Signature
1703-
1704-
AddCheckResultsToTcState results tcState
1705-
1706-
let partialResult : PartialResult = tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile
1707-
let hasErrors = logger.ErrorCount > 0
1708-
let priorOrCurrentErrors = priorErrors || hasErrors
1709-
let state : State = updatedTcState, priorOrCurrentErrors
1710-
1711-
partialResult, state
1712-
)
1713-
}
1714-
|> Cancellable.runWithoutCancellation
17151721

17161722
let go (fileIndex : int, (input, logger)) : State -> int * (PartialResult * State) =
1717-
let r = processFile (input, logger)
1723+
let r = processFile currentTcState (input, logger)
17181724
fun state ->
17191725
fileIndex, r state
17201726

‎tests/FSharp.Compiler.Service.Tests2/FileInfoGathering.fs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -14,16 +14,16 @@ let internal gatherBackingInfo (files : SourceFiles) : Files =
1414
let fsiBacked =
1515
match f.AST with
1616
| ParsedInput.SigFile _ ->
17-
seenSigFiles.Add f.Name |> ignore
17+
// TODO Use QualifiedNameOfFile
18+
seenSigFiles.Add f.AST.FileName |> ignore
1819
false
1920
| ParsedInput.ImplFile _ ->
20-
let fsiName = System.IO.Path.ChangeExtension(f.Name, "fsi")
21+
let fsiName = System.IO.Path.ChangeExtension(f.QualifiedName, "fsi")
2122
let fsiBacked = seenSigFiles.Contains fsiName
2223
fsiBacked
2324
{
24-
Name = f.Name
2525
Idx = FileIdx.make i
26-
Code = f.Code
26+
Code = "no code here" // TODO
2727
AST = f.AST
2828
FsiBacked = fsiBacked
2929
}

‎tests/FSharp.Compiler.Service.Tests2/GraphProcessing.fs‎

Lines changed: 13 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -75,13 +75,13 @@ let combineResults
7575
state
7676

7777
// TODO Could be replaced with a simpler recursive approach with memoised per-item results
78-
let processGraph<'Item, 'State, 'Result when 'Item : equality>
78+
let processGraph<'Item, 'State, 'Result, 'FinalFileResult when 'Item : equality>
7979
(graph : Graph<'Item>)
8080
(doWork : 'Item -> 'State -> 'Result)
81-
(folder : 'State -> 'Result -> 'State)
81+
(folder : 'State -> 'Result -> 'FinalFileResult * 'State)
8282
(emptyState : 'State)
8383
(parallelism : int)
84-
: 'State
84+
: 'FinalFileResult[] * 'State
8585
=
8686
let transitiveDeps = graph |> Graph.transitive
8787
let dependants = graph |> Graph.reverse
@@ -117,6 +117,9 @@ let processGraph<'Item, 'State, 'Result when 'Item : equality>
117117
=
118118
let deps = lookupMany node.Info.Deps
119119
let transitiveDeps = lookupMany node.Info.TransitiveDeps
120+
let folder state result =
121+
folder state result
122+
|> snd
120123
let inputState = combineResults emptyState deps transitiveDeps folder
121124
let singleRes = doWork node.Info.Item inputState
122125
let state = folder inputState singleRes
@@ -138,7 +141,6 @@ let processGraph<'Item, 'State, 'Result when 'Item : equality>
138141
)
139142
unblocked
140143

141-
142144
use cts = new CancellationTokenSource()
143145

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

151153
let nodesArray = nodes.Values |> Seq.toArray
152-
let state = combineResults emptyState nodesArray nodesArray folder
153-
state
154+
let x: 'FinalFileResult[] * 'State =
155+
nodesArray
156+
|> Array.fold (fun (fileResults, state) item ->
157+
let fileResult, state = folder state (item.Result.Value |> snd)
158+
Array.append fileResults [|fileResult|], state
159+
) ([||], emptyState)
160+
x

‎tests/FSharp.Compiler.Service.Tests2/ParallelTypeChecking.fs‎

Lines changed: 69 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,18 @@
11
module FSharp.Compiler.Service.Tests.ParallelTypeChecking
22

3+
open System.Threading
4+
open FSharp.Compiler
5+
open FSharp.Compiler.CheckBasics
6+
open FSharp.Compiler.CheckDeclarations
7+
open FSharp.Compiler.CompilerConfig
8+
open FSharp.Compiler.CompilerImports
9+
open FSharp.Compiler.DiagnosticsLogger
10+
open FSharp.Compiler.ParseAndCheckInputs
311
open FSharp.Compiler.Service.Tests.Graph
412
open FSharp.Compiler.Service.Tests.Types
13+
open FSharp.Compiler.Syntax
14+
open FSharp.Compiler.TcGlobals
15+
open FSharp.Compiler.TypedTree
516

617
type FileGraph = Graph<File>
718

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

1223
// TODO Use real things
1324
type State = string
14-
type SingleResult = int
25+
type FinalFileResult = string
26+
type SingleResult = State -> FinalFileResult * State
1527

1628
// TODO Use the real thing
1729
let typeCheckFile (file : File) (state : State) : SingleResult
1830
=
19-
file.Idx.Idx
31+
fun (state : State) ->
32+
let res = file.Idx.Idx
33+
res.ToString(), $"{state}+{res}"
2034

2135
// TODO Use the real thing
22-
let folder (state : State) (result : SingleResult) =
23-
$"{state}+{result}"
36+
let folder (state : State) (result : SingleResult): FinalFileResult * State =
37+
result state
38+
39+
module internal Real =
40+
41+
type State = TcState * bool
42+
type SingleResult = State -> FinalFileResult * State
43+
44+
// TODO Use the real thing
45+
let typeCheckFile (file : File) (state : State) : SingleResult
46+
=
47+
fun (state : State) ->
48+
let res = file.Idx.Idx
49+
res.ToString(), $"{state}+{res}"
50+
51+
type PartialResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType
52+
53+
/// Use parallel checking of implementation files that have signature files
54+
let CheckMultipleInputsInParallel2
55+
((ctok,
56+
checkForErrors,
57+
tcConfig: TcConfig,
58+
tcImports: TcImports,
59+
tcGlobals,
60+
prefixPathOpt,
61+
tcState,
62+
eagerFormat,
63+
inputs): CancellationToken * (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcState * (PhasedDiagnostic -> PhasedDiagnostic) * ParsedInput list) : PartialResult list * TcState =
64+
failwith ""
65+
66+
2467

25-
// TODO We probably need to return partial results as well
26-
let typeCheckGraph (graph : FileGraph) : State =
68+
69+
let folder (state : State) (result : SingleResult): FinalFileResult * State =
70+
result state
71+
72+
73+
let typeCheckGraph (graph : FileGraph) : FinalFileResult[] * State =
74+
let parallelism = 4 // cpu count?
75+
GraphProcessing.processGraph
76+
graph
77+
typeCheckFile
78+
folder
79+
""
80+
parallelism
81+
82+
let typeCheckGraph2 (graph : FileGraph) : FinalFileResult[] * State =
2783
let parallelism = 4 // cpu count?
28-
let state =
29-
GraphProcessing.processGraph
30-
graph
31-
typeCheckFile
32-
folder
33-
""
34-
parallelism
35-
state
84+
GraphProcessing.processGraph
85+
graph
86+
typeCheckFile
87+
folder
88+
""
89+
parallelism
3690

37-
let typeCheck (files : SourceFiles) : State =
91+
let typeCheck (files : SourceFiles) : FinalFileResult[] * State =
3892
let graph = calcFileGraph files
3993
let state = typeCheckGraph graph
4094
state

0 commit comments

Comments
 (0)