Skip to content

Commit c8098dc

Browse files
committed
NOT WORKING fsi stuff
1 parent dcafb5f commit c8098dc

File tree

9 files changed

+231
-103
lines changed

9 files changed

+231
-103
lines changed

src/Compiler/Driver/ParseAndCheckInputs.fs

Lines changed: 58 additions & 58 deletions
Original file line numberDiff line numberDiff line change
@@ -1471,23 +1471,26 @@ let CheckOneInputAux'
14711471

14721472
// Create dedicated state & some data for the .fs file type-checking later on - save it in a dict
14731473
let fsTcState =
1474-
let hadSig = true
1474+
// let hadSig = true
14751475
// Add dummy .fs results
14761476
// Adjust the TcState as if it has been checked, which makes the signature for the file available later
14771477
// in the compilation order.
14781478
let tcStateForImplFile = tcState
14791479
let fsName = file.FileName.TrimEnd('i')
1480-
let fsQualifiedName = asts[fsName].QualifiedName
1481-
let qualNameOfFile = fsQualifiedName
1480+
// let fsQualifiedName = asts[fsName].QualifiedName
1481+
// let qualNameOfFile = fsQualifiedName
14821482
let priorErrors = checkForErrors ()
1483-
1484-
// Add dummy TcState so that others can use this file through the .fsi stuff, without type-checking .fs
1485-
// Don't use it for this file's type-checking - it will cause duplicates
1486-
let ccuSigForFile, tcState =
1487-
AddCheckResultsToTcState
1488-
(tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, sigFileType)
1489-
tcState
1490-
1483+
//
1484+
// // Add dummy TcState so that others can use this file through the .fsi stuff, without type-checking .fs
1485+
// // Don't use it for this file's type-checking - it will cause duplicates
1486+
// let ccuSigForFile, tcState =
1487+
// AddCheckResultsToTcState
1488+
// (tcGlobals, amap, hadSig, prefixPathOpt, tcSink, tcState.tcsTcImplEnv, qualNameOfFile, sigFileType)
1489+
// tcState
1490+
1491+
// TODO Do we
1492+
let _, _, _, ccuSigForFile = fsiPartialResult
1493+
14911494
// Save info needed for type-checking .fs file later on
14921495
let fsiBackedInfo: FsiBackedInfo =
14931496
let ast = asts[fsName]
@@ -1522,47 +1525,49 @@ let CheckOneInputAux'
15221525

15231526
// Check if we've got an interface for this fragment
15241527
let rootSigOpt = tcState.tcsRootSigs.TryFind qualNameOfFile
1525-
1528+
15261529
match rootSigOpt with
1527-
| Some _ ->
1528-
// Type-check an implementation file backed by a signature file
1529-
let info = fsiBackedInfos[file.FileName]
1530-
match info with
1531-
| amap, conditionalDefines, rootSig, priorErrors, file, tcStateForImplFile, ccuSigForFile ->
1532-
1533-
// Check if we've already seen an implementation for this fragment
1534-
if Zset.contains qualNameOfFile tcStateForImplFile.tcsRootImpls then
1535-
errorR (Error(FSComp.SR.buildImplementationAlreadyGiven (qualNameOfFile.Text), m))
1536-
1537-
// In the first linear part of parallel checking, we use a 'checkForErrors' that checks either for errors
1538-
// somewhere in the files processed prior to this one, including from the first phase, or in the processing
1539-
// of this particular file.
1540-
// TODO: Are we handling the commented out code somewhere else?
1541-
let checkForErrors2 () = priorErrors // || (logger.ErrorCount > 0)
1542-
1543-
let topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes =
1544-
CheckOneImplFile(
1545-
tcGlobals,
1546-
amap,
1547-
tcStateForImplFile.tcsCcu,
1548-
tcStateForImplFile.tcsImplicitOpenDeclarations,
1549-
checkForErrors2,
1550-
conditionalDefines,
1551-
TcResultsSink.NoSink,
1552-
tcConfig.internalTestSpanStackReferring,
1553-
tcStateForImplFile.tcsTcImplEnv,
1554-
Some rootSig,
1555-
file
1556-
)
1557-
|> Cancellable.runWithoutCancellation
1558-
1559-
let result = (tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile)
1560-
1561-
// Type-check .fs file using dedicated stuff, not the main tcState as that will cause duplicates.
1562-
// Do not return resuling tcState - it shouldn't be used for anything.
1563-
// Return old tcState, with the exception of one flag.
1564-
return fun tcState ->
1565-
result, { tcState with tcsCreatesGeneratedProvidedTypes = tcState.CreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes }
1530+
| Some _
1531+
// ->
1532+
// // Type-check an implementation file backed by a signature file
1533+
// // TODO DO NOT
1534+
// let info = fsiBackedInfos[file.FileName]
1535+
// match info with
1536+
// | amap, conditionalDefines, rootSig, priorErrors, file, tcStateForImplFile, ccuSigForFile ->
1537+
//
1538+
// // Check if we've already seen an implementation for this fragment
1539+
// if Zset.contains qualNameOfFile tcStateForImplFile.tcsRootImpls then
1540+
// errorR (Error(FSComp.SR.buildImplementationAlreadyGiven (qualNameOfFile.Text), m))
1541+
//
1542+
// // In the first linear part of parallel checking, we use a 'checkForErrors' that checks either for errors
1543+
// // somewhere in the files processed prior to this one, including from the first phase, or in the processing
1544+
// // of this particular file.
1545+
// // TODO: Are we handling the commented out code somewhere else?
1546+
// let checkForErrors2 () = priorErrors // || (logger.ErrorCount > 0)
1547+
//
1548+
// let topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes =
1549+
// CheckOneImplFile(
1550+
// tcGlobals,
1551+
// amap,
1552+
// tcStateForImplFile.tcsCcu,
1553+
// tcStateForImplFile.tcsImplicitOpenDeclarations,
1554+
// checkForErrors2,
1555+
// conditionalDefines,
1556+
// TcResultsSink.NoSink,
1557+
// tcConfig.internalTestSpanStackReferring,
1558+
// tcStateForImplFile.tcsTcImplEnv,
1559+
// Some rootSig,
1560+
// file
1561+
// )
1562+
// |> Cancellable.runWithoutCancellation
1563+
//
1564+
// let result = (tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile)
1565+
//
1566+
// // Type-check .fs file using dedicated stuff, not the main tcState as that will cause duplicates.
1567+
// // Do not return resuling tcState - it shouldn't be used for anything.
1568+
// // Return old tcState, with the exception of one flag.
1569+
// return fun tcState ->
1570+
// result, { tcState with tcsCreatesGeneratedProvidedTypes = tcState.CreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes }
15661571
| None ->
15671572
// Typecheck the implementation file not backed by a signature file
15681573

@@ -1581,7 +1586,7 @@ let CheckOneInputAux'
15811586
tcSink,
15821587
tcConfig.internalTestSpanStackReferring,
15831588
tcState.tcsTcImplEnv,
1584-
None,
1589+
rootSigOpt,
15851590
file
15861591
)
15871592

@@ -1620,12 +1625,7 @@ let CheckOneInput'
16201625
skipImplIfSigExists: bool): (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcResultsSink * TcState * ParsedInput * bool)
16211626
: Cancellable<TcState -> PartialResult * TcState>
16221627
=
1623-
cancellable {
1624-
let! f =
1625-
CheckOneInputAux'(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input, skipImplIfSigExists)
1626-
// TODO Handle skipImplIfSigExists
1627-
return f
1628-
}
1628+
CheckOneInputAux'(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input, skipImplIfSigExists)
16291629

16301630

16311631

src/Compiler/Driver/ParseAndCheckInputs.fsi

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -145,6 +145,12 @@ val AddCheckResultsToTcState :
145145

146146
type PartialResult = TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType
147147

148+
type FsiBackedInfo =
149+
Import.ImportMap * string list option * ModuleOrNamespaceType *
150+
bool * ParsedImplFileInput * TcState * ModuleOrNamespaceType
151+
152+
val mutable fsiBackedInfos : System.Collections.Generic.Dictionary<string, FsiBackedInfo>
153+
148154
type CheckArgs = CompilationThreadToken * (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcState * (PhasedDiagnostic -> PhasedDiagnostic) * ParsedInput list
149155

150156
/// Use parallel checking of implementation files that have signature files

tests/FSharp.Compiler.Service.Tests2/DepResolving.fs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -241,8 +241,8 @@ module internal AutomatedDependencyResolving =
241241
let graph =
242242
nodes
243243
// TODO Async + cancellations
244-
|> Array.map processFile
245-
// |> Array.Parallel.map processFile
244+
// |> Array.map processFile
245+
|> Array.Parallel.map processFile
246246
|> readOnlyDict
247247

248248
let totalSize1 =

tests/FSharp.Compiler.Service.Tests2/DiamondArgs.txt

Lines changed: 1 addition & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -210,9 +210,4 @@
210210
--refout:C:\projekty\fsharp\heuristic\artifacts\obj\DiamondTest\Debug\net7.0\refint\DiamondTest.dll
211211
C:\projekty\fsharp\heuristic\tests\DiamondTest\A.fsi
212212
C:\projekty\fsharp\heuristic\tests\DiamondTest\A.fs
213-
C:\projekty\fsharp\heuristic\tests\DiamondTest\B1.fs
214-
C:\projekty\fsharp\heuristic\tests\DiamondTest\B2.fs
215-
C:\projekty\fsharp\heuristic\tests\DiamondTest\C1.fs
216-
C:\projekty\fsharp\heuristic\tests\DiamondTest\C2.fs
217-
C:\projekty\fsharp\heuristic\tests\DiamondTest\D.fs
218-
C:\projekty\fsharp\heuristic\tests\DiamondTest\Program.fs
213+
C:\projekty\fsharp\heuristic\tests\DiamondTest\B1.fs

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

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@ let internal gatherBackingInfo (files : SourceFiles) : Files =
2424
{
2525
Idx = FileIdx.make i
2626
Code = "no code here" // TODO
27-
AST = f.AST
27+
AST = ASTOrX.AST f.AST
2828
FsiBacked = fsiBacked
2929
}
3030
)
@@ -46,9 +46,9 @@ type FileData =
4646
}
4747
with member this.CodeSize = this.File.CodeSize
4848

49-
let private gatherFileData (file : File) : ExtractedData =
50-
let moduleRefs, containsModuleAbbreviations = ASTVisit.findModuleRefs file.AST
51-
let tops = ASTVisit.topModuleOrNamespaces file.AST
49+
let private gatherFileData (ast : ParsedInput) : ExtractedData =
50+
let moduleRefs, containsModuleAbbreviations = ASTVisit.findModuleRefs ast
51+
let tops = ASTVisit.topModuleOrNamespaces ast
5252
// TODO As a perf optimisation we can skip top-level ids scanning for FsiBacked .fs files
5353
// However, it is unlikely to give a noticable speedup due to parallelism (citation needed)
5454
{
@@ -64,7 +64,8 @@ let gatherForAllFiles (files : SourceFiles) =
6464
files
6565
// TODO Proper async with cancellation
6666
|> Array.Parallel.map (fun f ->
67-
let data = gatherFileData f
67+
let ast = match f.AST with ASTOrX.AST ast -> ast | X _ -> failwith "Unexpected X item"
68+
let data = gatherFileData ast
6869
{
6970
File = f
7071
Data = data

tests/FSharp.Compiler.Service.Tests2/Graph.fs

Lines changed: 19 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -10,10 +10,28 @@ type Graph<'Node> = IReadOnlyDictionary<'Node, 'Node[]>
1010

1111
module Graph =
1212

13+
let fillEmptyNodes<'Node when 'Node : equality> (graph : Graph<'Node>) : Graph<'Node> =
14+
let missingNodes =
15+
graph.Values
16+
|> Seq.toArray
17+
|> Array.concat
18+
|> Array.except graph.Keys
19+
20+
let toAdd =
21+
missingNodes
22+
|> Array.map (fun n -> KeyValuePair(n, [||]))
23+
24+
let x = Array.append (graph |> Seq.toArray) toAdd
25+
x
26+
|> Dictionary<_,_> |> fun x -> x :> IReadOnlyDictionary<_,_>
27+
1328
let transitive<'Node when 'Node : equality> (graph : Graph<'Node>) : Graph<'Node> =
1429
let rec calcTransitiveEdges =
1530
fun (node : 'Node) ->
16-
let edgeTargets = graph[node]
31+
let edgeTargets =
32+
match graph.TryGetValue node with
33+
| true, x -> x
34+
| false, _ -> failwith "FOO"
1735
edgeTargets
1836
|> Array.collect calcTransitiveEdges
1937
|> Array.append edgeTargets

0 commit comments

Comments
 (0)