[WIP] Parallel ILX Codegen

src/fsharp/IlxGen.fs

@@ -6,6 +6,7 @@ module internal FSharp.Compiler.IlxGen
 open System.IO
 open System.Reflection
 open System.Collections.Generic
+open System.Collections.Immutable
 
 open Internal.Utilities
 open Internal.Utilities.Collections
@@ -966,6 +967,10 @@ and IlxGenEnv =
 
       /// Are we inside of a recursive let binding, while loop, or a for loop?
       isInLoop: bool
+
+      delayCodeGen: bool
+
+      delayedFileGen: ImmutableArray<(cenv -> unit) []>
     }
 
     override _.ToString() = "<IlxGenEnv>"
@@ -2321,7 +2326,7 @@ let rec GenExpr cenv cgbuf eenv sp (expr: Expr) sequel =
 
     cenv.exprRecursionDepth <- cenv.exprRecursionDepth - 1
 
-    if cenv.exprRecursionDepth = 0 then
+    if cenv.exprRecursionDepth = 0 && not eenv.delayCodeGen then
         ProcessDelayedGenMethods cenv
 
 and ProcessDelayedGenMethods cenv =
@@ -2515,7 +2520,20 @@ and CodeGenMethodForExpr cenv mgbuf (spReq, entryPointInfo, methodName, eenv, al
         CodeGenMethod cenv mgbuf (entryPointInfo, methodName, eenv, alreadyUsedArgs,
                                    (fun cgbuf eenv -> GenExpr cenv cgbuf eenv spReq expr0 sequel0),
                                    expr0.Range)
-    code      
+    code
+
+and DelayCodeGenMethodForExpr cenv mgbuf (spReq, entryPointInfo, methodName, eenv, alreadyUsedArgs, expr0, sequel0) =
+    let ilLazyCode =
+        lazy
+            CodeGenMethodForExpr { cenv with exprRecursionDepth = 0; delayedGenMethods = Queue() } mgbuf (spReq, entryPointInfo, methodName, { eenv with delayCodeGen = false }, alreadyUsedArgs, expr0, sequel0)
+
+    if cenv.exprRecursionDepth > 0 || eenv.delayCodeGen then
+        cenv.delayedGenMethods.Enqueue(fun _ -> ilLazyCode.Force() |> ignore)
+    else
+        // Eagerly codegen if we are not in an expression depth.
+        ilLazyCode.Force() |> ignore
+
+    ilLazyCode
 
 //--------------------------------------------------------------------------
 // Generate sequels
@@ -5668,8 +5686,14 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) star
         cgbuf.mgbuf.AddOrMergePropertyDef(ilGetterMethSpec.MethodRef.DeclaringTypeRef, ilPropDef, m)
 
         let ilMethodDef =
-            let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPSuppress, [], ilGetterMethSpec.Name, eenv, 0, rhsExpr, Return)
-            let ilMethodBody = MethodBody.IL(lazy ilCode)
+            let ilLazyCode =
+                if eenv.delayCodeGen then
+                    DelayCodeGenMethodForExpr cenv cgbuf.mgbuf (SPSuppress, [], ilGetterMethSpec.Name, eenv, 0, rhsExpr, Return)
+                else
+                    let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPSuppress, [], ilGetterMethSpec.Name, eenv, 0, rhsExpr, Return)
+                    lazy ilCode
+
+            let ilMethodBody = MethodBody.IL(ilLazyCode)
             (mkILStaticMethod ([], ilGetterMethSpec.Name, access, [], mkILReturn ilTy, ilMethodBody)).WithSpecialName
             |> AddNonUserCompilerGeneratedAttribs g
 
@@ -6121,9 +6145,6 @@ and ComputeMethodImplAttribs cenv (_v: Val) attrs =
     let hasAggressiveInliningImplFlag = (implflags &&& 0x0100) <> 0x0
     hasPreserveSigImplFlag, hasSynchronizedImplFlag, hasNoInliningImplFlag, hasAggressiveInliningImplFlag, attrs
 
-and DelayGenMethodForBinding cenv mgbuf eenv ilxMethInfoArgs =
-    cenv.delayedGenMethods.Enqueue (fun cenv -> GenMethodForBinding cenv mgbuf eenv ilxMethInfoArgs)
-
 and GenMethodForBinding
         cenv mgbuf eenv
         (v: Val, mspec, hasWitnessEntry, generateWitnessArgs, access, ctps, mtps, witnessInfos, curriedArgInfos, paramInfos, argTys, retInfo, topValInfo,
@@ -6212,20 +6233,10 @@ and GenMethodForBinding
                 else
                     body
 
-            let ilCodeLazy = lazy CodeGenMethodForExpr cenv mgbuf (SPAlways, tailCallInfo, mspec.Name, eenvForMeth, 0, bodyExpr, sequel)
+            let ilLazyCode = DelayCodeGenMethodForExpr cenv mgbuf (SPAlways, tailCallInfo, mspec.Name, eenvForMeth, 0, bodyExpr, sequel)
 
             // This is the main code generation for most methods
-            false, MethodBody.IL(ilCodeLazy), false
-
-    match ilMethodBody with
-    | MethodBody.IL(ilCodeLazy) ->
-        if cenv.exprRecursionDepth > 0 then
-            cenv.delayedGenMethods.Enqueue(fun _ -> ilCodeLazy.Force() |> ignore)
-        else
-            // Eagerly codegen if we are not in an expression depth.
-            ilCodeLazy.Force() |> ignore
-    | _ ->
-        ()
+            false, MethodBody.IL(ilLazyCode), false
 
     // Do not generate DllImport attributes into the code - they are implicit from the P/Invoke
     let attrs =
@@ -7122,7 +7133,9 @@ and GenImplFile cenv (mgbuf: AssemblyBuilder) mainInfoOpt eenv (implFile: TypedI
         let allocVal = ComputeAndAddStorageForLocalTopVal (cenv.amap, g, cenv.intraAssemblyInfo, cenv.opts.isInteractive, NoShadowLocal)
         AddBindingsForLocalModuleType allocVal clocCcu eenv mexpr.Type
 
-    eenvafter
+    let eenvfinal = { eenvafter with delayedFileGen = eenvafter.delayedFileGen.Add(cenv.delayedGenMethods |> Array.ofSeq) }
+    cenv.delayedGenMethods.Clear()
+    eenvfinal
 
 and GenForceWholeFileInitializationAsPartOfCCtor cenv (mgbuf: AssemblyBuilder) (lazyInitInfo: ResizeArray<_>) tref m =
     // Authoring a .cctor with effects forces the cctor for the 'initialization' module by doing a dummy store & load of a field
@@ -8002,6 +8015,14 @@ let CodegenAssembly cenv eenv mgbuf implFiles =
         let eenv = List.fold (GenImplFile cenv mgbuf None) eenv a
         let eenv = GenImplFile cenv mgbuf cenv.opts.mainMethodInfo eenv b
 
+        let genMeths = eenv.delayedFileGen |> Array.ofSeq
+
+        genMeths
+        |> ArrayParallel.iter (fun genMeths ->
+            genMeths
+            |> Array.iter (fun gen -> gen cenv) 
+        )
+
         // Some constructs generate residue types and bindings. Generate these now. They don't result in any
         // top-level initialization code.
         let extraBindings = mgbuf.GrabExtraBindingsToGenerate()
@@ -8039,7 +8060,9 @@ let GetEmptyIlxGenEnv (g: TcGlobals) ccu =
       innerVals = []
       sigToImplRemapInfo = [] (* "module remap info" *)
       withinSEH = false
-      isInLoop = false }
+      isInLoop = false
+      delayCodeGen = true
+      delayedFileGen = ImmutableArray.Empty }
 
 type IlxGenResults =
     { ilTypeDefs: ILTypeDef list

src/fsharp/ParseAndCheckInputs.fs

@@ -712,6 +712,9 @@ type TcState =
         { x with tcsTcSigEnv = tcEnvAtEndOfLastInput
                  tcsTcImplEnv = tcEnvAtEndOfLastInput }
 
+    member x.RemoveImpl qualifiedNameOfFile =
+        { x with tcsRootImpls = x.tcsRootImpls.Remove(qualifiedNameOfFile) }
+
 
 /// Create the initial type checking state for compiling an assembly
 let GetInitialTcState(m, ccuName, tcConfig: TcConfig, tcGlobals, tcImports: TcImports, niceNameGen, tcEnv0) =
@@ -876,19 +879,26 @@ let TypeCheckOneInputEventually (checkForErrors, tcConfig: TcConfig, tcImports:
             return (tcState.TcEnvFromSignatures, EmptyTopAttrs, None, tcState.tcsCcuSig), tcState
     }
 
-/// Typecheck a single file (or interactive entry into F# Interactive)
-let TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp =
+let TypeCheckOneInputAux (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp skipImplIfSigExists =
     // 'use' ensures that the warning handler is restored at the end
     use unwindEL = PushErrorLoggerPhaseUntilUnwind(fun oldLogger -> GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput inp, oldLogger) )
     use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck
 
     RequireCompilationThread ctok
-    TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp, false) 
+    TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp, skipImplIfSigExists) 
         |> Eventually.force CancellationToken.None
         |> function 
            | ValueOrCancelled.Value v -> v
            | ValueOrCancelled.Cancelled ce ->  raise ce // this condition is unexpected, since CancellationToken.None was passed
 
+/// Typecheck a single file (or interactive entry into F# Interactive)
+let TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp =
+    TypeCheckOneInputAux(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp false
+
+/// Typecheck a single file but skip it if the file is an impl and has a backing sig
+let TypeCheckOneInputSkipImpl (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp =
+    TypeCheckOneInputAux(ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp true
+
 /// Finish checking multiple files (or one interactive entry into F# Interactive)
 let TypeCheckMultipleInputsFinish(results, tcState: TcState) =
     let tcEnvsAtEndFile, topAttrs, implFiles, ccuSigsForFiles = List.unzip4 results
@@ -918,9 +928,39 @@ let TypeCheckClosedInputSetFinish (declaredImpls: TypedImplFile list, tcState) =
 
     tcState, declaredImpls
 
-let TypeCheckClosedInputSet (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) =
+let TypeCheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) =
     // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions 
-    let results, tcState = (tcState, inputs) ||> List.mapFold (TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) 
+    let results, tcState =
+        if tcConfig.concurrentBuild then
+            let results, tcState = (tcState, inputs) ||> List.mapFold (TypeCheckOneInputSkipImpl (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) 
+
+            let inputs = Array.ofList inputs
+            let newResults = Array.ofList results
+            let results = Array.ofList results
+
+            (inputs, results) 
+            ||> Array.zip
+            |> Array.mapi (fun i (input, (_, _, implOpt, _)) ->
+                match implOpt with
+                | None -> None
+                | Some impl ->
+                    match impl with
+                    | TypedImplFile.TImplFile(qualifiedNameOfFile=qualifiedNameOfFile;implementationExpressionWithSignature=ModuleOrNamespaceExprWithSig.ModuleOrNamespaceExprWithSig(contents=ModuleOrNamespaceExpr.TMDefs [])) ->
+                        Some(i, input, qualifiedNameOfFile)
+                    | _ ->
+                        None
+            )
+            |> Array.choose id
+            |> ArrayParallel.iter (fun (i, input, qualifiedNameOfFile) ->
+                let tcState = tcState.RemoveImpl(qualifiedNameOfFile)
+                let result, _ = TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState input
+                newResults.[i] <- result
+            )
+
+            newResults |> List.ofArray, tcState
+        else
+            (tcState, inputs) ||> List.mapFold (TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) 
+
     let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _), tcState = TypeCheckMultipleInputsFinish(results, tcState)
     let tcState, declaredImpls = TypeCheckClosedInputSetFinish (implFiles, tcState)
     tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile

src/fsharp/ParseAndCheckInputs.fsi

@@ -78,6 +78,8 @@ type TcState =
 
     member CreatesGeneratedProvidedTypes: bool
 
+    member RemoveImpl: QualifiedNameOfFile -> TcState
+
 /// Get the initial type checking state for a set of inputs
 val GetInitialTcState: 
     range * string * TcConfig * TcGlobals * TcImports * NiceNameGenerator * TcEnv -> TcState

src/fsharp/absil/bytes.fs

@@ -5,6 +5,7 @@ namespace Internal.Utilities
 
 open System
 open System.IO
+open System.Buffers
 open System.IO.MemoryMappedFiles
 open System.Runtime.InteropServices
 open FSharp.NativeInterop
@@ -439,10 +440,16 @@ type internal ByteBuffer =
         let oldBufSize = buf.bbArray.Length 
         if newSize > oldBufSize then 
             let old = buf.bbArray 
-            buf.bbArray <- Bytes.zeroCreate (max newSize (oldBufSize * 2))
+            buf.bbArray <- ArrayPool.Shared.Rent(max newSize (oldBufSize * 2))
             Bytes.blit old 0 buf.bbArray 0 buf.bbCurrent
+            ArrayPool.Shared.Return(old)
 
-    member buf.Close () = Bytes.sub buf.bbArray 0 buf.bbCurrent
+    member buf.Close () = 
+        let result = Bytes.sub buf.bbArray 0 buf.bbCurrent
+        ArrayPool.Shared.Return(buf.bbArray)
+        buf.bbArray <- [||]
+        buf.bbCurrent <- 0
+        result
 
     member buf.EmitIntAsByte (i:int) = 
         let newSize = buf.bbCurrent + 1 
@@ -506,7 +513,7 @@ type internal ByteBuffer =
     member buf.Position = buf.bbCurrent
 
     static member Create sz = 
-        { bbArray=Bytes.zeroCreate sz 
+        { bbArray = ArrayPool.Shared.Rent(sz) 
           bbCurrent = 0 }
 
 [<Sealed>]

src/fsharp/lib.fsi

@@ -295,6 +295,10 @@ type DisposablesTracker =
 [<RequireQualifiedAccess>]
 module ArrayParallel =
 
+    val inline iter : ('T -> unit) -> 'T [] -> unit
+
+    val inline iteri : (int -> 'T -> unit) -> 'T [] -> unit
+
     val inline map : ('T -> 'U) -> 'T [] -> 'U []
 
     val inline mapi : (int -> 'T -> 'U) -> 'T [] -> 'U []