* Cleanup

* Start creating proper config

Author: safesparrow

src/Compiler/Driver/CompilerConfig.fs

@@ -393,6 +393,18 @@ type ParallelReferenceResolution =
     | On
     | Off
 
+[<RequireQualifiedAccess>]
+type TypeCheckingMode =
+    | Sequential
+    | ParallelCheckingOfBackedImplFiles
+    | Graph
+
+[<RequireQualifiedAccess>]
+type TypeCheckingConfig =
+    {
+        Mode : TypeCheckingMode
+    }
+
 [<NoEquality; NoComparison>]
 type TcConfigBuilder =
     {
@@ -507,7 +519,6 @@ type TcConfigBuilder =
         mutable emitTailcalls: bool
         mutable deterministic: bool
         mutable concurrentBuild: bool
-        mutable parallelCheckingWithSignatureFiles: bool
         mutable emitMetadataAssembly: MetadataAssemblyGeneration
         mutable preferredUiLang: string option
         mutable lcid: int option
@@ -587,6 +598,8 @@ type TcConfigBuilder =
         mutable exiter: Exiter
 
         mutable parallelReferenceResolution: ParallelReferenceResolution
+        
+        mutable typeCheckingConfig : TypeCheckingConfig
     }
 
     // Directories to start probing in
@@ -733,7 +746,6 @@ type TcConfigBuilder =
             emitTailcalls = true
             deterministic = false
             concurrentBuild = true
-            parallelCheckingWithSignatureFiles = false
             emitMetadataAssembly = MetadataAssemblyGeneration.None
             preferredUiLang = None
             lcid = None
@@ -775,6 +787,10 @@ type TcConfigBuilder =
             xmlDocInfoLoader = None
             exiter = QuitProcessExiter
             parallelReferenceResolution = ParallelReferenceResolution.Off
+            typeCheckingConfig =
+                {
+                    TypeCheckingConfig.Mode = TypeCheckingMode.Sequential
+                }
         }
 
     member tcConfigB.FxResolver =
@@ -1286,7 +1302,6 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) =
     member _.emitTailcalls = data.emitTailcalls
     member _.deterministic = data.deterministic
     member _.concurrentBuild = data.concurrentBuild
-    member _.parallelCheckingWithSignatureFiles = data.parallelCheckingWithSignatureFiles
     member _.emitMetadataAssembly = data.emitMetadataAssembly
     member _.pathMap = data.pathMap
     member _.langVersion = data.langVersion
@@ -1319,6 +1334,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) =
     member _.xmlDocInfoLoader = data.xmlDocInfoLoader
     member _.exiter = data.exiter
     member _.parallelReferenceResolution = data.parallelReferenceResolution
+    member _.typeCheckingConfig = data.typeCheckingConfig
 
     static member Create(builder, validate) =
         use _ = UseBuildPhase BuildPhase.Parameter

src/Compiler/Driver/CompilerConfig.fsi

@@ -203,6 +203,18 @@ type ParallelReferenceResolution =
     | On
     | Off
 
+[<RequireQualifiedAccess>]
+type TypeCheckingMode =
+    | Sequential
+    | ParallelCheckingOfBackedImplFiles
+    | Graph
+
+[<RequireQualifiedAccess>]
+type TypeCheckingConfig =
+    {
+        Mode : TypeCheckingMode
+    }
+
 [<NoEquality; NoComparison>]
 type TcConfigBuilder =
     {
@@ -412,8 +424,6 @@ type TcConfigBuilder =
 
         mutable concurrentBuild: bool
 
-        mutable parallelCheckingWithSignatureFiles: bool
-
         mutable emitMetadataAssembly: MetadataAssemblyGeneration
 
         mutable preferredUiLang: string option
@@ -489,6 +499,8 @@ type TcConfigBuilder =
         mutable exiter: Exiter
 
         mutable parallelReferenceResolution: ParallelReferenceResolution
+        
+        mutable typeCheckingConfig : TypeCheckingConfig
     }
 
     static member CreateNew:
@@ -732,8 +744,6 @@ type TcConfig =
 
     member concurrentBuild: bool
 
-    member parallelCheckingWithSignatureFiles: bool
-
     member emitMetadataAssembly: MetadataAssemblyGeneration
 
     member pathMap: PathMap
@@ -853,6 +863,8 @@ type TcConfig =
     member exiter: Exiter
 
     member parallelReferenceResolution: ParallelReferenceResolution
+    
+    member typeCheckingConfig : TypeCheckingConfig
 
 /// Represents a computation to return a TcConfig. Normally this is just a constant immutable TcConfig,
 /// but for F# Interactive it may be based on an underlying mutable TcConfigBuilder.

src/Compiler/Driver/CompilerOptions.fs

@@ -1387,7 +1387,8 @@ let testFlag tcConfigB =
             | "ShowLoadedAssemblies" -> tcConfigB.showLoadedAssemblies <- true
             | "ContinueAfterParseFailure" -> tcConfigB.continueAfterParseFailure <- true
             | "ParallelOff" -> tcConfigB.concurrentBuild <- false
-            | "ParallelCheckingWithSignatureFilesOn" -> tcConfigB.parallelCheckingWithSignatureFiles <- true
+            | "ParallelCheckingWithSignatureFilesOn" ->
+                tcConfigB.typeCheckingConfig <- { tcConfigB.typeCheckingConfig with Mode = TypeCheckingMode.ParallelCheckingOfBackedImplFiles }
 #if DEBUG
             | "ShowParserStackOnParseError" -> showParserStackOnParseError <- true
 #endif

src/Compiler/Driver/ParseAndCheckInputs.fs

@@ -1728,18 +1728,21 @@ let CheckMultipleInputsInParallel
 
         results, tcState)
 
-/// Use parallel checking of implementation files that have signature files
-let mutable CheckMultipleInputsInParallel2 : CheckArgs -> (PartialResult list * TcState)
+/// A mutable to allow injection the implementation from another project
+let mutable CheckMultipleInputsUsingGraphMode : CheckArgs -> (PartialResult list * TcState)
     =
-    CheckMultipleInputsInParallel        
+    fun _ -> failwith $"Graph-based type-checking function not set - set CheckMultipleInputsUsingGraphMode before using this mode"
 
 let CheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat, inputs) =
     // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions
     let results, tcState =
-        if tcConfig.parallelCheckingWithSignatureFiles then
-            CheckMultipleInputsInParallel2(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat, inputs)
-        else
+        match tcConfig.typeCheckingConfig.Mode with
+        | TypeCheckingMode.Sequential ->
             CheckMultipleInputsSequential(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs)
+        | TypeCheckingMode.ParallelCheckingOfBackedImplFiles ->
+            CheckMultipleInputsInParallel(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat, inputs)
+        | TypeCheckingMode.Graph ->
+            CheckMultipleInputsUsingGraphMode(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat, inputs)
 
     let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _), tcState =
         CheckMultipleInputsFinish(results, tcState)

src/Compiler/Driver/ParseAndCheckInputs.fsi

@@ -156,7 +156,7 @@ val mutable fsiBackedInfos : System.Collections.Concurrent.ConcurrentDictionary<
 type CheckArgs = CompilationThreadToken * (unit -> bool) * TcConfig * TcImports * TcGlobals * LongIdent option * TcState * (PhasedDiagnostic -> PhasedDiagnostic) * ParsedInput list
 
 /// Use parallel checking of implementation files that have signature files
-val mutable CheckMultipleInputsInParallel2 : (CheckArgs -> PartialResult list * TcState)
+val mutable CheckMultipleInputsUsingGraphMode : (CheckArgs -> PartialResult list * TcState)
 
 /// Get the initial type checking state for a set of inputs
 val GetInitialTcState: range * string * TcConfig * TcGlobals * TcImports * TcEnv * OpenDeclaration list -> TcState

src/Compiler/Service/IncrementalBuild.fs

@@ -1519,7 +1519,8 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc
                     }
                     |> Some
 
-                tcConfigB.parallelCheckingWithSignatureFiles <- enableParallelCheckingWithSignatureFiles
+                let mode = if enableParallelCheckingWithSignatureFiles then TypeCheckingMode.ParallelCheckingOfBackedImplFiles else TypeCheckingMode.Sequential
+                tcConfigB.typeCheckingConfig <- { tcConfigB.typeCheckingConfig with Mode = mode }
                 tcConfigB.parallelReferenceResolution <- parallelReferenceResolution
 
                 tcConfigB, sourceFilesNew

src/fsc/fscmain.fs

@@ -30,7 +30,7 @@ type Timer(name : string) =
         member this.Dispose() = this.Dispose()
 
 
-let internal mainAux2 (argv : string[], onlyTypeCheck : bool, exiter : Exiter option) : int =
+let internal mainAux (argv : string[], onlyTypeCheck : bool, exiter : Exiter option) : int =
     use _ = FSharp.Compiler.Diagnostics.Activity.startNoTags "fscmain"
 
     use _ = new Timer("main")
@@ -118,4 +118,4 @@ let internal mainAux2 (argv : string[], onlyTypeCheck : bool, exiter : Exiter op
 
 [<EntryPoint>]
 let main (argv : string[]) : int =
-    mainAux2 (argv, false, None)
+    mainAux (argv, false, None)

tests/ParallelTypeCheckingTests/Code/ASTVisit.fs

@@ -3,6 +3,8 @@
 open FSharp.Compiler.Syntax
 open FSharp.Compiler.SyntaxTrivia
 
+type SimpleId = string[]
+
 [<AutoOpen>]
 module X =
     let unsupported = "unsupported"
@@ -13,7 +15,7 @@ type ReferenceKind =
 /// Reference to a module or type, found in the AST
 type Reference =
     {
-        Ident : LongIdent
+        Ident : SimpleId
         Kind : ReferenceKind
     }
 
@@ -28,13 +30,28 @@ type ReferenceOrAbbreviation =
 
 type private References = ReferenceOrAbbreviation seq
 
+type ReferenceSimple =
+    {
+        Ident : string[]
+        Kind : ReferenceKind
+    }
+
+/// Reference to a module or type, found in the AST
+type ReferenceOrAbbreviationSimple =
+    | Reference of ReferenceSimple
+    | Abbreviation of Abbreviation
+
 module Array =
     let split<'a, 'b, 'c> (splitter : 'a -> Choice<'b, 'c>) (items : 'a[]) =
         let items = items |> Array.map splitter
         items |> Array.choose (function Choice1Of2 x -> Some x | _ -> None),
         items |> Array.choose (function Choice2Of2 x -> Some x | _ -> None)
 
 module ASTVisit =
+    
+    let extractSimpleId (longIdent : LongIdent) : SimpleId =
+        longIdent |> Seq.map (fun id -> id.idText) |> Seq.toArray
+    
     let rec visitSynModuleDecl (decl : SynModuleDecl) : References =
         // TODO
         match decl with
@@ -678,7 +695,7 @@ module ASTVisit =
         | SynOpenDeclTarget.Type(typeName, range) ->
             visitType typeName
         | SynOpenDeclTarget.ModuleOrNamespace(synLongIdent, range) ->
-            [ReferenceOrAbbreviation.Reference {Ident = synLongIdent.LongIdent; Kind = ReferenceKind.ModuleOrNamespace}] 
+            [ReferenceOrAbbreviation.Reference {Ident = synLongIdent.LongIdent |> extractSimpleId; Kind = ReferenceKind.ModuleOrNamespace}] 
 
     and visitSynComponentInfo (info : SynComponentInfo) : References =
         match info with
@@ -693,10 +710,10 @@ module ASTVisit =
             }
 
     and visitLongIdent (ident : LongIdent) : References =
-        [ReferenceOrAbbreviation.Reference {Ident = ident; Kind = ReferenceKind.Type}]
+        [ReferenceOrAbbreviation.Reference {Ident = ident |> extractSimpleId; Kind = ReferenceKind.Type}]
 
     and visitSynLongIdent (ident : SynLongIdent) : References  =
-        [ReferenceOrAbbreviation.Reference {Ident = ident.LongIdent; Kind = ReferenceKind.Type}]
+        [ReferenceOrAbbreviation.Reference {Ident = ident.LongIdent |> extractSimpleId; Kind = ReferenceKind.Type}]
 
     and visitSynMatchClause (x : SynMatchClause) : References =
         match x with
@@ -1097,14 +1114,16 @@ module ASTVisit =
         | ParsedInput.SigFile(ParsedSigFileInput(fileName, qualifiedNameOfFile, scopedPragmas, parsedHashDirectives, synModuleOrNamespaceSigs, parsedSigFileInputTrivia)) ->
             synModuleOrNamespaceSigs
             |> Seq.collect visitSynModuleOrNamespaceSig
-            |> Seq.toArray
         | ParsedInput.ImplFile(ParsedImplFileInput(fileName, isScript, qualifiedNameOfFile, scopedPragmas, parsedHashDirectives, synModuleOrNamespaces, flags, parsedImplFileInputTrivia)) ->
             synModuleOrNamespaces
             |> Seq.collect visitSynModuleOrNamespace
-            |> Seq.toArray
+        |> Seq.distinct
+        |> Seq.toArray
+    
+    
 
     /// Extract partial module references from partial module or type references
-    let extractModuleSegments (stuff : ReferenceOrAbbreviation seq): LongIdent[] * Abbreviation[] =
+    let extractModuleSegments (stuff : ReferenceOrAbbreviation seq): SimpleId[] * Abbreviation[] =
         let refs, abbreviations =
             stuff
             |> Seq.toArray
@@ -1120,7 +1139,7 @@ module ASTVisit =
                     match x.Ident.Length with
                     | 0
                     | 1 -> None
-                    | n -> x.Ident.GetSlice(Some 0, n - 2 |> Some) |> Some
+                    | n -> x.Ident[0..n-2]  |> Some
             )
             |> Seq.toArray
 
@@ -1276,3 +1295,5 @@ module TopModulesExtraction =
                 items
                 |> List.toArray
                 |> Array.collect topStuffForSynModuleOrNamespaceSig
+        |> Array.map ASTVisit.extractSimpleId
+        |> Array.distinct

tests/ParallelTypeCheckingTests/Code/DepResolving.fs

@@ -8,7 +8,6 @@ open ParallelTypeCheckingTests
 open ParallelTypeCheckingTests.FileInfoGathering
 open ParallelTypeCheckingTests.Graph
 open ParallelTypeCheckingTests.Types
-open ParallelTypeCheckingTests.ASTVisit
 open FSharp.Compiler.Syntax
 
 let log (msg : string) =
@@ -88,19 +87,19 @@ module internal AutomatedDependencyResolving =
     let buildTrie (files : FileData[]) : TrieNode =
         let root = emptyTrie()
 
-        let addFileIdent (file : FileData) (ident : LongIdent) =
+        let addFileIdent (file : FileData) (ident : SimpleId) =
             // Go down from root using segments of the identifier, possibly extending the Trie with new nodes.
             let mutable node = root
             for segment in ident do
                 let child =
-                    match node.Children.TryGetValue segment.idText with
+                    match node.Children.TryGetValue segment with
                     // Child exists
                     | true, child ->
                         child
                     // Child doesn't exist
                     | false, _ ->
                         let child = emptyTrie()
-                        node.Children[segment.idText] <- child
+                        node.Children[segment] <- child
                         child
                 node <- child
             // Add the file to the found leaf's list
@@ -195,24 +194,24 @@ module internal AutomatedDependencyResolving =
                     /// When the path leads outside the Trie, the Trie is not extended and no node is marked as a potential prefix.
                     /// This is just a performance optimisation - all the files are linked to already existing nodes, so there is no need to create and visit deeper nodes. 
                     /// </remarks>
-                    let rec walkDownAndMark (id : LongIdent) (node : TrieNode) =
+                    let rec walkDownAndMark (id : SimpleId) (node : TrieNode) =
                         match id with
                         // Reached end of the identifier - new reachable node 
-                        | [] ->
+                        | [||] ->
                             markPotentialPrefix node
                         // More segments exist
-                        | segment :: rest ->
+                        | id ->
                             // Visit (not 'reach') the TrieNode
                             markReachable node
-                            match node.Children.TryGetValue(segment.idText) with
+                            match node.Children.TryGetValue id[0] with
                             // A child for the segment exists - continue there
                             | true, child ->
-                                walkDownAndMark rest child
+                                walkDownAndMark id[1..] child
                             // A child for the segment doesn't exist - stop, since we don't care about the non-existent part of the Trie
                             | false, _ ->
                                 ()
 
-                    let processRef (id : LongIdent) =
+                    let processRef (id : SimpleId) =
                         // Start at every potential prefix,
                         List<_>(potentialPrefixes) // Copy the list for iteration as the original is going to be extended.
                         // Extend potential prefixes with this 'id'

tests/ParallelTypeCheckingTests/Code/FileInfoGathering.fs

@@ -32,10 +32,10 @@ let internal gatherBackingInfo (files : SourceFiles) : Files =
 type ExtractedData =
     {
         /// Order of the file in the project. Files with lower number cannot depend on files with higher number
-        Tops : LongIdent[]
+        Tops : SimpleId[]
         Abbreviations : Abbreviation[]
         /// All partial module references found in this file's AST
-        ModuleRefs : LongIdent[]
+        ModuleRefs : SimpleId[]
     }
 
 /// All the data about a single file needed for the dependency resolution algorithm