Skip to content

Commit 783a253

Browse files
safesparrowsafesparrow
committed
FCS works.
1 parent 9beca10 commit 783a253

8 files changed

Lines changed: 55 additions & 15 deletions

File tree

‎src/Compiler/Driver/ParseAndCheckInputs.fs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1428,7 +1428,7 @@ let CheckOneInputAux'
14281428

14291429
match inp with
14301430
| ParsedInput.SigFile file ->
1431-
printfn $"Processing Sig {file.FileName}"
1431+
// printfn $"Processing Sig {file.FileName}"
14321432
let qualNameOfFile = file.QualifiedName
14331433

14341434
// Check if we've seen this top module signature before.
@@ -1462,7 +1462,7 @@ let CheckOneInputAux'
14621462

14631463

14641464
// Save info needed for type-checking .fs file later on
1465-
printfn $"[{Thread.CurrentThread.ManagedThreadId}] Saving fsiBackedInfos for {file.FileName}"
1465+
// printfn $"[{Thread.CurrentThread.ManagedThreadId}] Saving fsiBackedInfos for {file.FileName}"
14661466
fsiBackedInfos[file.FileName] <- sigFileType
14671467

14681468
// printfn $"Finished Processing Sig {file.FileName}"

‎tests/ParallelTypeCheckingTests/Code/ASTVisit.fs‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1182,7 +1182,11 @@ module TopModulesExtraction =
11821182
// Stay safe and as soon as the parent module is reachable, consider this module reachable as well
11831183
[|LongIdent.Empty|]
11841184
else
1185-
[|longId|]
1185+
// 'module A.B' is equivalent to 'namespace A; module B', meaning that 'A' is opened implicitly
1186+
if synModuleOrNamespaceKind.IsModule then
1187+
[|longId.GetSlice(None, Some <| longId.Length-2); longId|]
1188+
else
1189+
[|longId|]
11861190
// TODO Temporarily disabled digging into the file's structure to avoid edge cases where another file depends on this file's namespace existing (but nothing else)
11871191
// synModuleDecls
11881192
// |> moduleDecls

‎tests/ParallelTypeCheckingTests/Code/GraphProcessing.fs‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -203,6 +203,9 @@ let processGraph<'Item, 'State, 'Result, 'FinalFileResult when 'Item : equality
203203
}
204204
finalFileResult, state
205205

206+
printfn $"Node count: {nodes.Count}"
207+
// let mutable cnt = 1
208+
206209
let work
207210
(node : Node<'Item, StateWrapper<'Item, 'State>, ResultWrapper<'Item, 'Result>>)
208211
: Node<'Item, StateWrapper<'Item, 'State>, ResultWrapper<'Item, 'Result>>[]
@@ -230,6 +233,16 @@ let processGraph<'Item, 'State, 'Result, 'FinalFileResult when 'Item : equality
230233
)
231234
pdc = x.Info.Deps.Length
232235
)
236+
// printfn $"State after {node.Info.Item}"
237+
// nodes
238+
// |> Seq.map (fun (KeyValue(_, v)) ->
239+
// let x = v.Info.Deps.Length - v.ProcessedDepsCount
240+
// $"{v.Info.Item} - {x} deps left"
241+
// )
242+
// |> Seq.iter (fun x -> printfn $"{x}")
243+
// let c = cnt
244+
// cnt <- cnt+1
245+
// printfn $"Finished processing node. {unblocked.Length} nodes unblocked"
233246
unblocked
234247

235248
use cts = new CancellationTokenSource()

‎tests/ParallelTypeCheckingTests/Code/Parallel.fs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -81,18 +81,18 @@ let processInParallel
8181
(parallelism : int)
8282
(stop : int -> bool)
8383
(ct : CancellationToken)
84-
(itemToString)
84+
(_itemToString)
8585
: unit
8686
=
8787
let bc = new BlockingCollection<'Item>()
8888
firstItems |> Array.iter bc.Add
8989
let processedCountLock = Object()
9090
let mutable processedCount = 0
9191
let processItem item =
92-
printfn $"Processing {itemToString item}"
92+
// printfn $"Processing {itemToString item}"
9393
let toSchedule = work item
9494
let processedCount = lock processedCountLock (fun () -> processedCount <- processedCount + 1; processedCount)
95-
printfn $"ToSchedule {toSchedule.Length}"
95+
// printfn $"ToSchedule {toSchedule.Length}"
9696
toSchedule
9797
|> Array.iter (
9898
fun next -> bc.Add(next)

‎tests/ParallelTypeCheckingTests/Code/ParallelTypeChecking.fs‎

Lines changed: 11 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
#nowarn "1182"
33
open System.Collections.Concurrent
44
open System.Collections.Generic
5+
open System.Threading
56
open FSharp.Compiler
67
open FSharp.Compiler.CheckBasics
78
open FSharp.Compiler.CheckDeclarations
@@ -72,7 +73,7 @@ let CheckMultipleInputsInParallel
7273
let mutable nextIdx = (graph.Files |> Array.map (fun f -> f.File.Idx.Idx) |> Array.max) + 1
7374
let fakeX (idx : FileIdx) (fsi : File) : FileData =
7475
{
75-
File = File.FakeFs idx fsi.QualifiedName
76+
File = File.FakeFs idx fsi.Name
7677
Data =
7778
{
7879
Tops = [||]
@@ -131,6 +132,8 @@ let CheckMultipleInputsInParallel
131132
// somewhere in the files processed prior to each one, or in the processing of this particular file.
132133
let priorErrors = checkForErrors ()
133134

135+
let mutable cnt = 1
136+
134137
let processFile
135138
(file : File)
136139
((input, logger) : ParsedInput * DiagnosticsLogger)
@@ -143,10 +146,11 @@ let CheckMultipleInputsInParallel
143146
let checkForErrors2 () = priorErrors || (logger.ErrorCount > 0)
144147

145148
let tcSink = TcResultsSink.NoSink
146-
149+
let c = cnt
150+
cnt <- cnt + 1
147151
match file.AST with
148152
| ASTOrX.AST _ ->
149-
// printfn $"Processing AST {file.ToString()}"
153+
printfn $"#{c} [thread {Thread.CurrentThread.ManagedThreadId}] Type-checking {file.ToString()}"
150154
let! f = CheckOneInput'(
151155
checkForErrors2,
152156
tcConfig,
@@ -159,7 +163,7 @@ let CheckMultipleInputsInParallel
159163
false // skipImpFiles...
160164
)
161165

162-
printfn $"Finished Processing AST {file.ToString()}"
166+
// printfn $"Finished Processing AST {file.ToString()}"
163167
return
164168
(fun (state : State) ->
165169
// printfn $"Applying {file.ToString()}"
@@ -174,7 +178,7 @@ let CheckMultipleInputsInParallel
174178
partialResult, state
175179
)
176180
| ASTOrX.X fsi ->
177-
// printfn $"Processing X {file.ToString()}"
181+
// printfn $"[{c}] Processing X {file.ToString()}"
178182

179183
let hadSig = true
180184
// Add dummy .fs results
@@ -188,7 +192,6 @@ let CheckMultipleInputsInParallel
188192
// Don't use it for this file's type-checking - it will cause duplicates
189193

190194
let ccuSigForFile = fsiBackedInfos[fsi]
191-
printfn $"Finished Processing X {file}"
192195
return
193196
(fun (state : State) ->
194197
// (tcState.TcEnvFromImpls, EmptyTopAttrs, None, ccuSigForFile), state
@@ -236,14 +239,15 @@ let CheckMultipleInputsInParallel
236239
let _qnof = QualifiedNameOfFile.QualifiedNameOfFile (Ident("", Range.Zero))
237240
let state: State = tcState, priorErrors
238241

242+
239243
let partialResults, (tcState, _) =
240244
GraphProcessing.processGraph<File, State, SingleResult, FinalFileResult>
241245
graph
242246
processFile
243247
folder
244248
state
245249
(fun it -> not <| it.Name.EndsWith(".fsix"))
246-
8
250+
10
247251

248252
partialResults |> Array.toList, tcState
249253
)

‎tests/ParallelTypeCheckingTests/Program.fs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,6 @@ let _parse (argv: string[]): Args =
3131
[<EntryPoint>]
3232
let main _argv =
3333
let args = _parse _argv
34-
let args = {args with LineLimit = Some 219}
34+
let args = {args with LineLimit = None}
3535
TestCompilationFromCmdlineArgs.TestCompilerFromArgs args
3636
0

‎tests/ParallelTypeCheckingTests/Tests/TestCompilationFromCmdlineArgs.fs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@ type Codebase =
1717

1818
let codebases =
1919
[|
20-
{ WorkDir = $@"{__SOURCE_DIRECTORY__}\.checkouts\fcs\src\compiler"; Path = $@"{__SOURCE_DIRECTORY__}\FCS.args.txt"; Limit = Some 237 }
20+
{ WorkDir = $@"{__SOURCE_DIRECTORY__}\.checkouts\fcs\src\compiler"; Path = $@"{__SOURCE_DIRECTORY__}\FCS.args.txt"; Limit = Some 211 }
2121
{ WorkDir = $@"{__SOURCE_DIRECTORY__}\.checkouts\fcs\tests\FSharp.Compiler.ComponentTests"; Path = $@"{__SOURCE_DIRECTORY__}\ComponentTests.args.txt"; Limit = None }
2222
|]
2323

‎tests/ParallelTypeCheckingTests/Tests/TestDependencyResolution.fs‎

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
module ParallelTypeCheckingTests.TestDependencyResolution
22
#nowarn "1182"
3+
open System.IO
34
open Buildalyzer
45
open ParallelTypeCheckingTests
56
open ParallelTypeCheckingTests.Types
@@ -116,6 +117,24 @@ type X = Y
116117
assertGraphEqual deps expectedEdges
117118

118119

120+
[<Test>]
121+
let ``Test error``() =
122+
let files =
123+
[|
124+
"pppars.fs", File.ReadAllText @"C:\projekty\fsharp\heuristic\tests\ParallelTypeCheckingTests\Tests\.checkouts\fcs\artifacts\obj\FSharp.Compiler.Service\Debug\netstandard2.0\pppars.fs"
125+
"pplex.fs", File.ReadAllText @"C:\projekty\fsharp\heuristic\tests\ParallelTypeCheckingTests\Tests\.checkouts\fcs\artifacts\obj\FSharp.Compiler.Service\Debug\netstandard2.0\pplex.fs"
126+
|]
127+
|> buildFiles
128+
129+
let deps = DependencyResolution.detectFileDependencies files
130+
131+
let expectedEdges =
132+
[
133+
"pplex.fs", ["pppars.fs"]
134+
]
135+
assertGraphEqual deps expectedEdges
136+
137+
119138
let sampleFiles =
120139
[
121140
"Abbr.fs", """

0 commit comments

Comments
 (0)