Skip to content

Commit 7435583

Browse files
nojafnojaf
committed
Correctly deal with merging the result of signature/implementation pair.
1 parent 46505f3 commit 7435583

5 files changed

Lines changed: 61 additions & 40 deletions

File tree

‎src/Compiler/Driver/ParseAndCheckInputs.fs‎

Lines changed: 44 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -1406,7 +1406,7 @@ let CheckOneInputAux'
14061406
tcState: TcState,
14071407
inp: ParsedInput,
14081408
_skipImplIfSigExists: bool): (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcResultsSink * TcState * ParsedInput * bool)
1409-
: Cancellable<TcState -> PartialResult * TcState> =
1409+
: Cancellable<bool -> TcState -> PartialResult * TcState> =
14101410

14111411
cancellable {
14121412
try
@@ -1457,7 +1457,7 @@ let CheckOneInputAux'
14571457

14581458
// printfn $"Finished Processing Sig {file.FileName}"
14591459
return
1460-
fun tcState ->
1460+
fun isFinalFold tcState ->
14611461
// printfn $"Applying Sig {file.FileName}"
14621462
let fsiPartialResult, tcState =
14631463
let rootSigs = Zmap.add qualNameOfFile sigFileType tcState.tcsRootSigs
@@ -1480,7 +1480,16 @@ let CheckOneInputAux'
14801480

14811481
partialResult, tcState
14821482

1483-
fsiPartialResult, tcState
1483+
if isFinalFold then
1484+
fsiPartialResult, tcState
1485+
else
1486+
// Update the TcEnv of implementation files to also contain the signature data.
1487+
let _ccuSigForFile, tcState =
1488+
AddCheckResultsToTcState
1489+
(tcGlobals, amap, true, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, sigFileType)
1490+
tcState
1491+
1492+
fsiPartialResult, tcState
14841493

14851494
| ParsedInput.ImplFile file ->
14861495
// printfn $"Processing Impl {file.FileName}"
@@ -1491,10 +1500,6 @@ let CheckOneInputAux'
14911500

14921501
// Typecheck the implementation file not backed by a signature file
14931502

1494-
// Check if we've already seen an implementation for this fragment
1495-
if Zset.contains qualNameOfFile tcState.tcsRootImpls then
1496-
errorR (Error(FSComp.SR.buildImplementationAlreadyGiven (qualNameOfFile.Text), m))
1497-
14981503
let! topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes =
14991504
CheckOneImplFile(
15001505
tcGlobals,
@@ -1512,32 +1517,45 @@ let CheckOneInputAux'
15121517

15131518
// printfn $"Finished Processing Impl {file.FileName}"
15141519
return
1515-
fun tcState ->
1516-
// let backed = rootSigOpt.IsSome
1517-
// printfn $"Applying Impl Backed={backed} {file.FileName}"
1520+
fun isFinalFold tcState ->
1521+
let addResultToState () =
1522+
// Check if we've already seen an implementation for this fragment
1523+
if Zset.contains qualNameOfFile tcState.tcsRootImpls then
1524+
errorR (Error(FSComp.SR.buildImplementationAlreadyGiven (qualNameOfFile.Text), m))
15181525

1519-
let ccuSigForFile, fsTcState =
1520-
AddCheckResultsToTcState
1521-
(tcGlobals, amap, false, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, implFile.Signature)
1522-
tcState
1526+
// printfn $"Applying Impl Backed={backed} {file.FileName}"
1527+
let ccuSigForFile, fsTcState =
1528+
AddCheckResultsToTcState
1529+
(tcGlobals, amap, false, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, implFile.Signature)
1530+
tcState
15231531

1524-
// backed impl files must not add results as there are already results from .fsi files
1525-
//let fsTcState = if backed then tcState else fsTcState
1532+
// backed impl files must not add results as there are already results from .fsi files
1533+
//let fsTcState = if backed then tcState else fsTcState
15261534

1527-
let partialResult = tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile
1535+
let partialResult = tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile
15281536

1529-
let tcState =
1530-
{ fsTcState with
1531-
tcsCreatesGeneratedProvidedTypes =
1532-
fsTcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes
1533-
}
1537+
let tcState =
1538+
{ fsTcState with
1539+
tcsCreatesGeneratedProvidedTypes =
1540+
fsTcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes
1541+
}
15341542

1535-
// printfn $"Finished applying Impl {file.FileName}"
1536-
partialResult, tcState
1543+
// printfn $"Finished applying Impl {file.FileName}"
1544+
partialResult, tcState
1545+
1546+
match rootSigOpt with
1547+
| None -> addResultToState ()
1548+
| Some _ when isFinalFold -> addResultToState ()
1549+
| Some rootSig ->
1550+
// In this case, we are skipping the step where we add the results of the implementation file to the tcState.
1551+
// The fold function of a signature file will add the result (of the signature),
1552+
// to the implementation when it is not processing the final fold.
1553+
let partialResult = tcEnvAtEnd, topAttrs, Some implFile, rootSig
1554+
partialResult, tcState
15371555

15381556
with e ->
15391557
errorRecovery e range0
1540-
return fun tcState -> (tcState.TcEnvFromSignatures, EmptyTopAttrs, None, tcState.tcsCcuSig), tcState
1558+
return fun _ tcState -> (tcState.TcEnvFromSignatures, EmptyTopAttrs, None, tcState.tcsCcuSig), tcState
15411559
}
15421560

15431561
/// Typecheck a single file (or interactive entry into F# Interactive). If skipImplIfSigExists is set to true
@@ -1552,7 +1570,7 @@ let CheckOneInput'
15521570
tcState: TcState,
15531571
input: ParsedInput,
15541572
skipImplIfSigExists: bool): (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcResultsSink * TcState * ParsedInput * bool)
1555-
: Cancellable<TcState -> PartialResult * TcState> =
1573+
: Cancellable<bool -> TcState -> PartialResult * TcState> =
15561574
CheckOneInputAux'(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input, skipImplIfSigExists)
15571575

15581576
// Within a file, equip loggers to locally filter w.r.t. scope pragmas in each input

‎src/Compiler/Driver/ParseAndCheckInputs.fsi‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -185,7 +185,7 @@ val CheckOneInput':
185185
tcState: TcState *
186186
input: ParsedInput *
187187
skipImplIfSigExists: bool ->
188-
Cancellable<TcState -> PartialResult * TcState>
188+
Cancellable<bool -> TcState -> PartialResult * TcState>
189189

190190
val CheckMultipleInputsInParallel:
191191
(CompilationThreadToken * (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcState * (PhasedDiagnostic -> PhasedDiagnostic) * ParsedInput list) ->

‎tests/ParallelTypeCheckingTests/Code/GraphProcessing.fs‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -141,7 +141,7 @@ let combineResults
141141
let processGraph<'Item, 'State, 'Result, 'FinalFileResult when 'Item: equality and 'Item: comparison>
142142
(graph: Graph<'Item>)
143143
(doWork: 'Item -> 'State -> 'Result)
144-
(folder: 'State -> 'Result -> 'FinalFileResult * 'State)
144+
(folder: bool -> 'State -> 'Result -> 'FinalFileResult * 'State)
145145
(foldingOrderer: 'Item -> int)
146146
(emptyState: 'State)
147147
(includeInFinalState: 'Item -> bool)
@@ -188,8 +188,8 @@ let processGraph<'Item, 'State, 'Result, 'FinalFileResult when 'Item: equality a
188188
State = emptyState
189189
}
190190

191-
let folder { Meta = meta; State = state } { Item = item; Result = result } =
192-
let finalFileResult, state = folder state result
191+
let folder (isFinalFold: bool) { Meta = meta; State = state } { Item = item; Result = result } =
192+
let finalFileResult, state = folder isFinalFold state result
193193

194194
let state =
195195
{
@@ -208,7 +208,7 @@ let processGraph<'Item, 'State, 'Result, 'FinalFileResult when 'Item: equality a
208208
let work
209209
(node: Node<'Item, StateWrapper<'Item, 'State>, ResultWrapper<'Item, 'Result>>)
210210
: Node<'Item, StateWrapper<'Item, 'State>, ResultWrapper<'Item, 'Result>>[] =
211-
let folder x y = folder x y |> snd
211+
let folder x y = folder false x y |> snd
212212
let deps = lookupMany node.Info.Deps
213213
let transitiveDeps = lookupMany node.Info.TransitiveDeps
214214
let inputState = combineResults emptyState deps transitiveDeps folder foldingOrderer
@@ -269,7 +269,7 @@ let processGraph<'Item, 'State, 'Result, 'FinalFileResult when 'Item: equality a
269269
nodes
270270
|> Array.fold
271271
(fun (fileResults, state) node ->
272-
let fileResult, state = folder state (node.Result.Value |> snd)
272+
let fileResult, state = folder true state (node.Result.Value |> snd)
273273
Array.append fileResults [| fileResult |], state)
274274
([||], emptyState)
275275

‎tests/ParallelTypeCheckingTests/Code/ParallelTypeChecking.fs‎

Lines changed: 10 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -31,12 +31,12 @@ let DiagnosticsLoggerForInput (tcConfig: TcConfig, input: ParsedInput, oldLogger
3131

3232
type State = TcState * bool
3333
type FinalFileResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType
34-
type SingleResult = State -> FinalFileResult * State
34+
type SingleResult = bool -> State -> FinalFileResult * State
3535
type Item = File
3636

3737
type PartialResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType
3838

39-
let folder (state: State) (result: SingleResult) : FinalFileResult * State = result state
39+
let folder (isFinalFold: bool) (state: State) (result: SingleResult) : FinalFileResult * State = result isFinalFold state
4040

4141
/// Use parallel checking of implementation files that have signature files
4242
let CheckMultipleInputsInParallel
@@ -80,7 +80,7 @@ let CheckMultipleInputsInParallel
8080
let processFile
8181
((input, logger): ParsedInput * DiagnosticsLogger)
8282
((currentTcState, _currentPriorErrors): State)
83-
: State -> PartialResult * State =
83+
: bool -> State -> PartialResult * State =
8484
cancellable {
8585
use _ = UseDiagnosticsLogger logger
8686
// printfn $"Processing AST {file.ToString()}"
@@ -108,10 +108,13 @@ let CheckMultipleInputsInParallel
108108

109109
// printfn $"Finished Processing AST {file.ToString()}"
110110
return
111-
(fun (state: State) ->
111+
(fun (isFinalFold: bool) (state: State) ->
112+
if isFinalFold then
113+
printfn "final fold for %s" input.FileName
114+
112115
// printfn $"Applying {file.ToString()}"
113116
let tcState, priorErrors = state
114-
let (partialResult: PartialResult, tcState) = f tcState
117+
let (partialResult: PartialResult, tcState) = f isFinalFold tcState
115118

116119
let hasErrors = logger.ErrorCount > 0
117120
// TODO Should we use local _priorErrors or global priorErrors?
@@ -131,11 +134,11 @@ let CheckMultipleInputsInParallel
131134
let logger = DiagnosticsLoggerForInput(tcConfig, input, oldLogger)
132135
input, logger)
133136

134-
let processFile (fileIdx: int) (state: State) : State -> PartialResult * State =
137+
let processFile (fileIdx: int) (state: State) : bool -> State -> PartialResult * State =
135138
let parsedInput, logger = inputsWithLoggers.[fileIdx]
136139
processFile (parsedInput, logger) state
137140

138-
let folder: State -> SingleResult -> FinalFileResult * State = folder
141+
let folder: bool -> State -> SingleResult -> FinalFileResult * State = folder
139142
let _qnof = QualifiedNameOfFile.QualifiedNameOfFile(Ident("", Range.Zero))
140143
let state: State = tcState, priorErrors
141144

‎tests/ParallelTypeCheckingTests/Tests/TrieMappingTests.fs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,7 @@ let ``Basic trie`` () =
4040
let trie = TrieMapping.mkTrie files
4141

4242
match trie.Current with
43-
| TrieNodeInfo.Root _ -> ()
43+
| TrieNodeInfo.Root -> ()
4444
| current -> Assert.Fail($"mkTrie should always return a TrieNodeInfo.Root, got {current}")
4545

4646
let xNode = trie.Children.["X"]

0 commit comments

Comments
 (0)