Parallel type-checking in compilation (behind a feature flag) (dotnet…

…#14494) Parallel type-checking in compilation (behind a feature flag) --------- Co-authored-by: nojaf <[email protected]>
KevinRansom · Feb 10, 2023 · 10c1eff · 10c1eff
1 parent a2c0c22
commit 10c1eff
Show file tree

Hide file tree

Showing 70 changed files with 5,270 additions and 232 deletions.
diff --git a/FSharpBuild.Directory.Build.props b/FSharpBuild.Directory.Build.props
@@ -26,7 +26,6 @@
     <WarningsAsErrors>1182;0025;$(WarningsAsErrors)</WarningsAsErrors>
     <OtherFlags>$(OtherFlags) --nowarn:3384</OtherFlags>
     <OtherFlags>$(OtherFlags) --times --nowarn:75</OtherFlags>
-    <OtherFlags Condition="$(ParallelCheckingWithSignatureFilesOn) == 'true'">$(OtherFlags) --test:ParallelCheckingWithSignatureFilesOn</OtherFlags>
     <OtherFlags Condition="$(AdditionalFscCmdFlags) != ''">$(OtherFlags) $(AdditionalFscCmdFlags)</OtherFlags>
   </PropertyGroup>
 

diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs
@@ -3028,6 +3028,17 @@ module EstablishTypeDefinitionCores =
                     let kind = if hasMeasureAttr then TyparKind.Measure else TyparKind.Type
                     let ty, _ = TcTypeOrMeasureAndRecover (Some kind) cenv NoNewTypars checkConstraints ItemOccurence.UseInType WarnOnIWSAM.No envinner tpenv rhsType
 
+                    // Give a warning if `AutoOpenAttribute` is being aliased.
+                    // If the user were to alias the `Microsoft.FSharp.Core.AutoOpenAttribute` type, it would not be detected by the project graph dependency resolution algorithm.
+                    match stripTyEqns g ty with
+                    | AppTy g (tcref, _) when not tcref.IsErased ->
+                        match tcref.CompiledRepresentation with
+                        | CompiledTypeRepr.ILAsmOpen _ -> ()
+                        | CompiledTypeRepr.ILAsmNamed _ ->
+                            if tcref.CompiledRepresentationForNamedType.FullName = g.attrib_AutoOpenAttribute.TypeRef.FullName then
+                                warning(Error(FSComp.SR.chkAutoOpenAttributeInTypeAbbrev(), tycon.Id.idRange))
+                    | _ -> ()
+
                     if not firstPass then 
                         let ftyvs = freeInTypeLeftToRight g false ty 
                         let typars = tycon.Typars m
@@ -4278,7 +4289,7 @@ module TcDeclarations =
 
                 if not (isNil members) && tcref.IsTypeAbbrev then 
                     errorR(Error(FSComp.SR.tcTypeAbbreviationsCannotHaveAugmentations(), tyDeclRange))
-
+                
                 let (SynComponentInfo (attributes, _, _, _, _, _, _, _)) = synTyconInfo
                 if not (List.isEmpty attributes) && (declKind = ExtrinsicExtensionBinding || declKind = IntrinsicExtensionBinding) then
                     let attributeRange = (List.head attributes).Range

diff --git a/src/Compiler/Driver/CompilerConfig.fs b/src/Compiler/Driver/CompilerConfig.fs
@@ -393,6 +393,18 @@ type ParallelReferenceResolution =
     | On
     | Off
 
+[<RequireQualifiedAccess>]
+type TypeCheckingMode =
+    | Sequential
+    | Graph
+
+[<RequireQualifiedAccess>]
+type TypeCheckingConfig =
+    {
+        Mode: TypeCheckingMode
+        DumpGraph: bool
+    }
+
 [<NoEquality; NoComparison>]
 type TcConfigBuilder =
     {
@@ -507,7 +519,6 @@ type TcConfigBuilder =
         mutable emitTailcalls: bool
         mutable deterministic: bool
         mutable concurrentBuild: bool
-        mutable parallelCheckingWithSignatureFiles: bool
         mutable parallelIlxGen: bool
         mutable emitMetadataAssembly: MetadataAssemblyGeneration
         mutable preferredUiLang: string option
@@ -591,6 +602,8 @@ type TcConfigBuilder =
         mutable parallelReferenceResolution: ParallelReferenceResolution
 
         mutable captureIdentifiersWhenParsing: bool
+
+        mutable typeCheckingConfig: TypeCheckingConfig
     }
 
     // Directories to start probing in
@@ -737,7 +750,6 @@ type TcConfigBuilder =
             emitTailcalls = true
             deterministic = false
             concurrentBuild = true
-            parallelCheckingWithSignatureFiles = FSharpExperimentalFeaturesEnabledAutomatically
             parallelIlxGen = FSharpExperimentalFeaturesEnabledAutomatically
             emitMetadataAssembly = MetadataAssemblyGeneration.None
             preferredUiLang = None
@@ -782,6 +794,15 @@ type TcConfigBuilder =
             exiter = QuitProcessExiter
             parallelReferenceResolution = ParallelReferenceResolution.Off
             captureIdentifiersWhenParsing = false
+            typeCheckingConfig =
+                {
+                    TypeCheckingConfig.Mode =
+                        if FSharpExperimentalFeaturesEnabledAutomatically then
+                            TypeCheckingMode.Graph
+                        else
+                            TypeCheckingMode.Sequential
+                    DumpGraph = false
+                }
         }
 
     member tcConfigB.FxResolver =
@@ -1286,7 +1307,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 _.parallelIlxGen = data.parallelIlxGen
     member _.emitMetadataAssembly = data.emitMetadataAssembly
     member _.pathMap = data.pathMap
@@ -1322,6 +1342,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) =
     member _.exiter = data.exiter
     member _.parallelReferenceResolution = data.parallelReferenceResolution
     member _.captureIdentifiersWhenParsing = data.captureIdentifiersWhenParsing
+    member _.typeCheckingConfig = data.typeCheckingConfig
 
     static member Create(builder, validate) =
         use _ = UseBuildPhase BuildPhase.Parameter

diff --git a/src/Compiler/Driver/CompilerConfig.fsi b/src/Compiler/Driver/CompilerConfig.fsi
@@ -203,6 +203,24 @@ type ParallelReferenceResolution =
     | On
     | Off
 
+/// Determines the algorithm used for type-checking.
+[<RequireQualifiedAccess>]
+type TypeCheckingMode =
+    /// Default mode where all source files are processed sequentially in compilation order.
+    | Sequential
+    /// Parallel type-checking that uses automated file-to-file dependency detection to construct a file graph processed in parallel.
+    | Graph
+
+/// Some of the information dedicated to type-checking.
+[<RequireQualifiedAccess>]
+type TypeCheckingConfig =
+    {
+        Mode: TypeCheckingMode
+        /// When using TypeCheckingMode.Graph, this flag determines whether the
+        /// resolved file graph should be serialised as a Mermaid diagram into a file next to the output dll.
+        DumpGraph: bool
+    }
+
 [<NoEquality; NoComparison>]
 type TcConfigBuilder =
     {
@@ -412,8 +430,6 @@ type TcConfigBuilder =
 
         mutable concurrentBuild: bool
 
-        mutable parallelCheckingWithSignatureFiles: bool
-
         mutable parallelIlxGen: bool
 
         mutable emitMetadataAssembly: MetadataAssemblyGeneration
@@ -495,6 +511,8 @@ type TcConfigBuilder =
         mutable parallelReferenceResolution: ParallelReferenceResolution
 
         mutable captureIdentifiersWhenParsing: bool
+
+        mutable typeCheckingConfig: TypeCheckingConfig
     }
 
     static member CreateNew:
@@ -738,8 +756,6 @@ type TcConfig =
 
     member concurrentBuild: bool
 
-    member parallelCheckingWithSignatureFiles: bool
-
     member parallelIlxGen: bool
 
     member emitMetadataAssembly: MetadataAssemblyGeneration
@@ -866,6 +882,8 @@ type TcConfig =
 
     member captureIdentifiersWhenParsing: bool
 
+    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.
 [<Sealed>]

diff --git a/src/Compiler/Driver/CompilerOptions.fs b/src/Compiler/Driver/CompilerOptions.fs
@@ -1372,8 +1372,17 @@ let testFlag tcConfigB =
             | "ShowLoadedAssemblies" -> tcConfigB.showLoadedAssemblies <- true
             | "ContinueAfterParseFailure" -> tcConfigB.continueAfterParseFailure <- true
             | "ParallelOff" -> tcConfigB.concurrentBuild <- false
-            | "ParallelCheckingWithSignatureFilesOn" -> tcConfigB.parallelCheckingWithSignatureFiles <- true
             | "ParallelIlxGen" -> tcConfigB.parallelIlxGen <- true
+            | "GraphBasedChecking" ->
+                tcConfigB.typeCheckingConfig <-
+                    { tcConfigB.typeCheckingConfig with
+                        Mode = TypeCheckingMode.Graph
+                    }
+            | "DumpCheckingGraph" ->
+                tcConfigB.typeCheckingConfig <-
+                    { tcConfigB.typeCheckingConfig with
+                        DumpGraph = true
+                    }
 #if DEBUG
             | "ShowParserStackOnParseError" -> showParserStackOnParseError <- true
 #endif

diff --git a/src/Compiler/Driver/GraphChecking/Continuation.fs b/src/Compiler/Driver/GraphChecking/Continuation.fs
@@ -0,0 +1,15 @@
+[<RequireQualifiedAccess>]
+module internal Continuation
+
+let rec sequence<'T, 'TReturn> (recursions: (('T -> 'TReturn) -> 'TReturn) list) (finalContinuation: 'T list -> 'TReturn) : 'TReturn =
+    match recursions with
+    | [] -> finalContinuation []
+    | andThenInner :: andThenInners ->
+        fun (results: 'T list) ->
+            fun (result: 'T) -> result :: results |> finalContinuation
+            |> andThenInner
+        |> sequence andThenInners
+
+let concatenate<'T, 'TReturn> (recursions: (('T list -> 'TReturn) -> 'TReturn) list) (finalContinuation: 'T list -> 'TReturn) : 'TReturn =
+    let ultimateContinuation = List.concat >> finalContinuation
+    sequence recursions ultimateContinuation
diff --git a/src/Compiler/Driver/GraphChecking/Continuation.fsi b/src/Compiler/Driver/GraphChecking/Continuation.fsi
@@ -0,0 +1,23 @@
+[<RequireQualifiedAccess>]
+module internal Continuation
+
+/// This function sequences computations that have been expressed in continuation-passing style.
+/// Concretely, when 'T is `int` as an example, can be expressed in continuation-passing style as a function,
+/// taking as its input another function that is "how to proceed with a computation given the value of the integer",
+/// and returning "the result of that computation".
+/// That is, an integer is equivalently represented as a generic function (howToProceed : int -> 'TReturn) -> 'TReturn,
+/// and the effect of the function corresponding to the integer 3 is simply to apply the input `howToProceed` to the value 3.
+///
+/// The motivation for Continuation.sequence is most easily understood when it is viewed without its second argument:
+/// it is a higher-order function that takes "a list of 'T expressed in continuation-passing style", and returns "a 'T list expressed in continuation-passing style".
+/// The resulting "continuation-passing 'T list" operates by chaining the input 'Ts together, and finally returning the result of continuing the computation after first sequencing the inputs.
+///
+/// Crucially, this technique can be used to enable unbounded recursion:
+/// it constructs and invokes closures representing intermediate stages of the sequenced computation on the heap, rather than consuming space on the (more constrained) stack.
+val sequence<'T, 'TReturn> :
+    recursions: (('T -> 'TReturn) -> 'TReturn) list -> finalContinuation: ('T list -> 'TReturn) -> 'TReturn
+
+/// Auxiliary function for `Continuation.sequence` that assumes the recursions return a 'T list.
+/// In the final continuation the `'T list list` will first be concatenated into one list, before being passed to the (final) `continuation`.
+val concatenate<'T, 'TReturn> :
+    recursions: (('T list -> 'TReturn) -> 'TReturn) list -> finalContinuation: ('T list -> 'TReturn) -> 'TReturn