From bf5d8519a5d4e25c905519cbf390442ac6c86706 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 29 Jun 2021 12:35:07 -0700 Subject: [PATCH 1/6] Added IncrementalBuilderInitialState --- src/fsharp/service/IncrementalBuild.fs | 95 +++++++++++++++++++++----- 1 file changed, 78 insertions(+), 17 deletions(-) diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 828c553e4e9..48fbbc5470c 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -701,6 +701,7 @@ type RawFSharpAssemblyDataBackedByLanguageService (tcConfig, tcGlobals, generate member _.HasAnyFSharpSignatureDataAttribute = true member _.HasMatchingFSharpSignatureDataAttribute = true +[] type IncrementalBuilderState = { // stampedFileNames represent the real stamps of the files. @@ -713,24 +714,82 @@ type IncrementalBuilderState = finalizedBoundModel: GraphNode<((ILAssemblyRef * IRawFSharpAssemblyData option * TypedImplFile list option * BoundModel) * DateTime)> } +[] +type IncrementalBuilderInitialState = + { + initialBoundModel: BoundModel + tcGlobals: TcGlobals + nonFrameworkAssemblyInputs: (Choice * (TimeStampCache -> DateTime)) list + tcConfig: TcConfig + outfile: string + assemblyName: string + lexResourceManager: Lexhelp.LexResourceManager + sourceFiles: (range * string * (bool * bool)) list + enablePartialTypeChecking: bool + beforeFileChecked: Event + fileChecked: Event +#if !NO_EXTENSIONTYPING + importsInvalidatedByTypeProvider: Event +#endif + allDependencies: string [] + defaultTimeStamp: DateTime + } + + static member Create( + initialBoundModel: BoundModel, + tcGlobals, + nonFrameworkAssemblyInputs, + tcConfig: TcConfig, + outfile, + assemblyName, + lexResourceManager, + sourceFiles, + enablePartialTypeChecking, + beforeFileChecked: Event, + fileChecked: Event, +#if !NO_EXTENSIONTYPING + importsInvalidatedByTypeProvider: Event, +#endif + allDependencies, + defaultTimeStamp: DateTime) = + { + initialBoundModel = initialBoundModel + tcGlobals = tcGlobals + nonFrameworkAssemblyInputs = nonFrameworkAssemblyInputs + tcConfig = tcConfig + outfile = outfile + assemblyName = assemblyName + lexResourceManager = lexResourceManager + sourceFiles = sourceFiles + enablePartialTypeChecking = enablePartialTypeChecking + beforeFileChecked = beforeFileChecked + fileChecked = fileChecked +#if !NO_EXTENSIONTYPING + importsInvalidatedByTypeProvider = importsInvalidatedByTypeProvider +#endif + allDependencies = allDependencies + defaultTimeStamp = defaultTimeStamp + } + /// Manages an incremental build graph for the build of a single F# project -type IncrementalBuilder( - initialBoundModel: BoundModel, - tcGlobals, - nonFrameworkAssemblyInputs, - tcConfig: TcConfig, - outfile, - assemblyName, - lexResourceManager, - sourceFiles, - enablePartialTypeChecking, - beforeFileChecked: Event, - fileChecked: Event, +type IncrementalBuilder(initialState: IncrementalBuilderInitialState) = + + let initialBoundModel = initialState.initialBoundModel + let tcGlobals = initialState.tcGlobals + let nonFrameworkAssemblyInputs = initialState.nonFrameworkAssemblyInputs + let tcConfig = initialState.tcConfig + let outfile = initialState.outfile + let assemblyName = initialState.assemblyName + let lexResourceManager = initialState.lexResourceManager + let sourceFiles = initialState.sourceFiles + let enablePartialTypeChecking = initialState.enablePartialTypeChecking + let beforeFileChecked = initialState.beforeFileChecked + let fileChecked = initialState.fileChecked #if !NO_EXTENSIONTYPING - importsInvalidatedByTypeProvider: Event, + let importsInvalidatedByTypeProvider = initialState.importsInvalidatedByTypeProvider #endif - allDependencies, - defaultTimeStamp: DateTime) = + let allDependencies = initialState.allDependencies + let defaultTimeStamp = initialState.defaultTimeStamp let fileParsed = new Event() let projectChecked = new Event() @@ -1524,8 +1583,8 @@ type IncrementalBuilder( importsInvalidatedByTypeProvider ) - let builder = - new IncrementalBuilder( + let initialState = + IncrementalBuilderInitialState.Create( initialBoundModel, tcGlobals, nonFrameworkAssemblyInputs, @@ -1542,6 +1601,8 @@ type IncrementalBuilder( #endif allDependencies, defaultTimeStamp) + + let builder = IncrementalBuilder(initialState) return Some builder with e -> errorRecoveryNoRange e From 27b1e6a452723ef5c87c0aabe0c6810f5bfe2994 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 29 Jun 2021 12:47:39 -0700 Subject: [PATCH 2/6] More changes --- src/fsharp/service/IncrementalBuild.fs | 63 ++++++++++++++------------ 1 file changed, 34 insertions(+), 29 deletions(-) diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 48fbbc5470c..57e10167fb3 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -728,11 +728,14 @@ type IncrementalBuilderInitialState = enablePartialTypeChecking: bool beforeFileChecked: Event fileChecked: Event + fileParsed: Event + projectChecked: Event #if !NO_EXTENSIONTYPING importsInvalidatedByTypeProvider: Event #endif allDependencies: string [] defaultTimeStamp: DateTime + mutable isImportsInvalidated: bool } static member Create( @@ -752,24 +755,33 @@ type IncrementalBuilderInitialState = #endif allDependencies, defaultTimeStamp: DateTime) = - { - initialBoundModel = initialBoundModel - tcGlobals = tcGlobals - nonFrameworkAssemblyInputs = nonFrameworkAssemblyInputs - tcConfig = tcConfig - outfile = outfile - assemblyName = assemblyName - lexResourceManager = lexResourceManager - sourceFiles = sourceFiles - enablePartialTypeChecking = enablePartialTypeChecking - beforeFileChecked = beforeFileChecked - fileChecked = fileChecked + + let initialState = + { + initialBoundModel = initialBoundModel + tcGlobals = tcGlobals + nonFrameworkAssemblyInputs = nonFrameworkAssemblyInputs + tcConfig = tcConfig + outfile = outfile + assemblyName = assemblyName + lexResourceManager = lexResourceManager + sourceFiles = sourceFiles + enablePartialTypeChecking = enablePartialTypeChecking + beforeFileChecked = beforeFileChecked + fileChecked = fileChecked + fileParsed = Event() + projectChecked = Event() #if !NO_EXTENSIONTYPING - importsInvalidatedByTypeProvider = importsInvalidatedByTypeProvider + importsInvalidatedByTypeProvider = importsInvalidatedByTypeProvider #endif - allDependencies = allDependencies - defaultTimeStamp = defaultTimeStamp - } + allDependencies = allDependencies + defaultTimeStamp = defaultTimeStamp + isImportsInvalidated = false + } +#if !NO_EXTENSIONTYPING + importsInvalidatedByTypeProvider.Publish.Add(fun () -> initialState.isImportsInvalidated <- true) +#endif + initialState /// Manages an incremental build graph for the build of a single F# project type IncrementalBuilder(initialState: IncrementalBuilderInitialState) = @@ -790,15 +802,8 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState) = #endif let allDependencies = initialState.allDependencies let defaultTimeStamp = initialState.defaultTimeStamp - - let fileParsed = new Event() - let projectChecked = new Event() - - let mutable isImportsInvalidated = false - -#if !NO_EXTENSIONTYPING - do importsInvalidatedByTypeProvider.Publish.Add(fun () -> isImportsInvalidated <- true) -#endif + let fileParsed = initialState.fileParsed + let projectChecked = initialState.projectChecked //---------------------------------------------------- // START OF BUILD TASK FUNCTIONS @@ -1114,8 +1119,8 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState) = if referencesUpdated then // Build is invalidated. The build must be rebuilt with the newly updated references. - if not isImportsInvalidated && canTriggerInvalidation then - isImportsInvalidated <- true + if not initialState.isImportsInvalidated && canTriggerInvalidation then + initialState.isImportsInvalidated <- true { state with stampedReferencedAssemblies = stampedReferencedAssemblies.ToImmutable() } @@ -1220,10 +1225,10 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState) = member _.IsReferencesInvalidated = // fast path - if isImportsInvalidated then true + if initialState.isImportsInvalidated then true else computeStampedReferencedAssemblies currentState true (TimeStampCache(defaultTimeStamp)) |> ignore - isImportsInvalidated + initialState.isImportsInvalidated member _.AllDependenciesDeprecated = allDependencies From dce6baa2b9fc198db7d8dcdbbe8c4db3c65d076c Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 29 Jun 2021 14:52:40 -0700 Subject: [PATCH 3/6] Added internal 'block' type for use in the compiler. Lifting functions out of IncrementalBuilder --- .../FSharp.Compiler.Service.fsproj | 6 + src/fsharp/block.fs | 222 +++++++++++ src/fsharp/block.fsi | 62 +++ src/fsharp/lib.fs | 1 + src/fsharp/service/IncrementalBuild.fs | 354 +++++++++--------- tests/FSharp.Compiler.UnitTests/BlockTests.fs | 58 +++ .../FSharp.Compiler.UnitTests.fsproj | 1 + 7 files changed, 526 insertions(+), 178 deletions(-) create mode 100644 src/fsharp/block.fs create mode 100644 src/fsharp/block.fsi create mode 100644 tests/FSharp.Compiler.UnitTests/BlockTests.fs diff --git a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index 996bdaca789..ff2d0cd0770 100644 --- a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -190,6 +190,12 @@ Utilities\lib.fs + + Utilities\block.fsi + + + Utilities\block.fs + Utilities\rational.fsi diff --git a/src/fsharp/block.fs b/src/fsharp/block.fs new file mode 100644 index 00000000000..2e43c11d80d --- /dev/null +++ b/src/fsharp/block.fs @@ -0,0 +1,222 @@ +module Internal.Utilities.Library.Block + +open System.Collections.Immutable + +type block<'T> = ImmutableArray<'T> +type blockbuilder<'T> = ImmutableArray<'T>.Builder + +[] +module BlockBuilder = + + let create size : blockbuilder<'T> = + if size = 0 then + ImmutableArray.CreateBuilder() + else + ImmutableArray.CreateBuilder(size) + +[] +module Block = + + let empty<'T> = ImmutableArray<'T>.Empty + + let init n (f: int -> 'T) : block<_> = + match n with + | 0 -> ImmutableArray.Empty + | 1 -> ImmutableArray.Create(f 0) + | n -> + if n < 0 then + invalidArg "n" "Below zero." + + let builder = ImmutableArray.CreateBuilder(n) + for i = 0 to n - 1 do + builder.Add(f i) + builder.ToImmutable() + + let iter f (arr: block<'T>) = + for i = 0 to arr.Length - 1 do + f arr.[i] + + let iteri f (arr: block<'T>) = + for i = 0 to arr.Length - 1 do + f i arr.[i] + + let iter2 f (arr1: block<'T1>) (arr2: block<'T2>) = + if arr1.Length <> arr2.Length then + invalidOp "Block lengths do not match." + + for i = 0 to arr1.Length - 1 do + f arr1.[i] arr2.[i] + + let iteri2 f (arr1: block<'T1>) (arr2: block<'T2>) = + if arr1.Length <> arr2.Length then + invalidOp "Block lengths do not match." + + for i = 0 to arr1.Length - 1 do + f i arr1.[i] arr2.[i] + + let map (mapper: 'T -> 'U) (arr: block<'T>) : block<_> = + match arr.Length with + | 0 -> block.Empty + | 1 -> ImmutableArray.Create(mapper arr.[0]) + | _ -> + let builder = ImmutableArray.CreateBuilder(arr.Length) + for i = 0 to arr.Length - 1 do + builder.Add(mapper arr.[i]) + builder.ToImmutable() + + let mapi (mapper: int -> 'T -> 'U) (arr: block<'T>) : block<_> = + match arr.Length with + | 0 -> block.Empty + | 1 -> ImmutableArray.Create(mapper 0 arr.[0]) + | _ -> + let builder = ImmutableArray.CreateBuilder(arr.Length) + for i = 0 to arr.Length - 1 do + builder.Add(mapper i arr.[i]) + builder.ToImmutable() + + let map2 (mapper: 'T1 -> 'T2 -> 'T) (arr1: block<'T1>) (arr2: block<'T2>) : block<_> = + if arr1.Length <> arr2.Length then + invalidOp "Block lengths do not match." + + match arr1.Length with + | 0 -> ImmutableArray.Empty + | 1 -> ImmutableArray.Create(mapper arr1.[0] arr2.[0]) + | n -> + let builder = ImmutableArray.CreateBuilder(n) + for i = 0 to n - 1 do + builder.Add(mapper arr1.[i] arr2.[i]) + builder.ToImmutable() + + let mapi2 (mapper: int -> 'T1 -> 'T2 -> 'T) (arr1: block<'T1>) (arr2: block<'T2>) : block<_> = + if arr1.Length <> arr2.Length then + invalidOp "Block lengths do not match." + + match arr1.Length with + | 0 -> ImmutableArray.Empty + | 1 -> ImmutableArray.Create(mapper 0 arr1.[0] arr2.[0]) + | n -> + let builder = ImmutableArray.CreateBuilder(n) + for i = 0 to n - 1 do + builder.Add(mapper i arr1.[i] arr2.[i]) + builder.ToImmutable() + + let concat (arr: block>) : block<'T> = + if arr.IsEmpty then + empty + elif arr.Length = 1 then + arr.[0] + elif arr.Length = 2 then + arr.[0].AddRange(arr.[1]) + else + let mutable arr2 = arr.[0] + for i = 1 to arr.Length - 1 do + arr2 <- arr2.AddRange(arr.[i]) + arr2 + + let forall predicate (arr: block<'T>) = + match arr.Length with + | 0 -> true + | 1 -> predicate arr.[0] + | n -> + let mutable result = true + let mutable i = 0 + while result && i < n do + result <- predicate arr.[i] + i <- i + 1 + result + + let forall2 predicate (arr1: block<'T1>) (arr2: block<'T2>) = + if arr1.Length <> arr2.Length then + invalidOp "Block lengths do not match." + + match arr1.Length with + | 0 -> true + | 1 -> predicate arr1.[0] arr2.[0] + | n -> + let mutable result = true + let mutable i = 0 + while result && i < n do + result <- predicate arr1.[i] arr2.[i] + i <- i + 1 + result + + let tryFind predicate (arr: block<'T>) = + match arr.Length with + | 0 -> None + | 1 -> if predicate arr.[0] then Some arr.[0] else None + | n -> + let mutable result = None + let mutable i = 0 + while result.IsNone && i < n do + if predicate arr.[i] then + result <- Some arr.[i] + i <- i + 1 + result + + let tryFindIndex predicate (arr: block<'T>) = + match arr.Length with + | 0 -> None + | 1 -> if predicate arr.[0] then Some 0 else None + | n -> + let mutable result = None + let mutable i = 0 + while result.IsNone && i < n do + if predicate arr.[i] then + result <- Some i + i <- i + 1 + result + + let tryPick chooser (arr: block<'T>) = + match arr.Length with + | 0 -> None + | 1 -> chooser arr.[0] + | n -> + let mutable result = None + let mutable i = 0 + while result.IsNone && i < n do + result <- chooser arr.[i] + i <- i + 1 + result + + let ofSeq (xs: 'T seq) = + ImmutableArray.CreateRange(xs) + + let append (arr1: block<'T1>) (arr2: block<'T1>) : block<_> = + arr1.AddRange(arr2) + + let createOne (item: 'T) : block<_> = + ImmutableArray.Create(item) + + let filter predicate (arr: block<'T>) : block<'T> = + let builder = ImmutableArray.CreateBuilder(arr.Length) + for i = 0 to arr.Length - 1 do + if predicate arr.[i] then + builder.Add(arr.[i]) + builder.ToImmutable() + + let exists predicate (arr: block<'T>) = + let n = arr.Length + let mutable result = false + let mutable i = 0 + while not result && i < n do + if predicate arr.[i] then + result <- true + i <- i + 1 + result + + let choose (chooser: 'T -> 'U option) (arr: block<'T>) : block<'U> = + let builder = ImmutableArray.CreateBuilder(arr.Length) + for i = 0 to arr.Length - 1 do + let result = chooser arr.[i] + if result.IsSome then + builder.Add(result.Value) + builder.ToImmutable() + + let isEmpty (arr: block<_>) = arr.Length = 0 + + let fold folder state (arr: block<_>) = + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(folder) + let mutable state = state + for i = 0 to arr.Length - 1 do + state <- f.Invoke(state, arr.[i]) + state diff --git a/src/fsharp/block.fsi b/src/fsharp/block.fsi new file mode 100644 index 00000000000..9790dabaa50 --- /dev/null +++ b/src/fsharp/block.fsi @@ -0,0 +1,62 @@ +[] +module internal Internal.Utilities.Library.Block + +open System.Collections.Immutable + +/// Type alias for System.Collections.Immutable.ImmutableArray<'T> +type block<'T> = ImmutableArray<'T> + +/// Type alias for System.Collections.Immutable.ImmutableArray<'T>.Builder +type blockbuilder<'T> = ImmutableArray<'T>.Builder + +[] +module BlockBuilder = + + val create : size: int -> blockbuilder<'T> + +[] +module Block = + + val empty<'T> : block<'T> + + val init : n: int -> f: (int -> 'T) -> block<'T> + + val iter : f: ('T -> unit) -> block<'T> -> unit + + val iteri : f: (int -> 'T -> unit) -> block<'T> -> unit + + val iter2 : f: ('T1 -> 'T2 -> unit) -> block<'T1> -> block<'T2> -> unit + + val iteri2 : f: (int -> 'T1 -> 'T2 -> unit) -> block<'T1> -> block<'T2> -> unit + + val map : mapper: ('T1 -> 'T2) -> block<'T1> -> block<'T2> + + val mapi : mapper: (int -> 'T1 -> 'T2) -> block<'T1> -> block<'T2> + + val concat : block> -> block<'T> + + val forall : predicate: ('T -> bool) -> block<'T> -> bool + + val forall2 : predicate: ('T1 -> 'T2 -> bool) -> block<'T1> -> block<'T2> -> bool + + val tryFind : predicate: ('T -> bool) -> block<'T> -> 'T option + + val tryFindIndex : predicate: ('T -> bool) -> block<'T> -> int option + + val tryPick : chooser: ('T1 -> 'T2 option) -> block<'T1> -> 'T2 option + + val ofSeq : seq<'T> -> block<'T> + + val append : block<'T> -> block<'T> -> block<'T> + + val createOne : 'T -> block<'T> + + val filter : predicate: ('T -> bool) -> block<'T> -> block<'T> + + val exists : predicate: ('T -> bool) -> block<'T> -> bool + + val choose : chooser: ('T -> 'U option) -> block<'T> -> block<'U> + + val isEmpty : block<'T> -> bool + + val fold : folder: ('State -> 'T -> 'State) -> 'State -> block<'T> -> 'State \ No newline at end of file diff --git a/src/fsharp/lib.fs b/src/fsharp/lib.fs index 07ba0f0f91f..ef4785546b3 100755 --- a/src/fsharp/lib.fs +++ b/src/fsharp/lib.fs @@ -604,3 +604,4 @@ module ArrayParallel = let inline map f (arr: 'T []) = arr |> mapi (fun _ item -> f item) + \ No newline at end of file diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 57e10167fb3..1495c3fe0c3 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -701,112 +701,8 @@ type RawFSharpAssemblyDataBackedByLanguageService (tcConfig, tcGlobals, generate member _.HasAnyFSharpSignatureDataAttribute = true member _.HasMatchingFSharpSignatureDataAttribute = true -[] -type IncrementalBuilderState = - { - // stampedFileNames represent the real stamps of the files. - // logicalStampedFileNames represent the stamps of the files that are used to calculate the project's logical timestamp. - stampedFileNames: ImmutableArray - logicalStampedFileNames: ImmutableArray - stampedReferencedAssemblies: ImmutableArray - initialBoundModel: GraphNode - boundModels: ImmutableArray> - finalizedBoundModel: GraphNode<((ILAssemblyRef * IRawFSharpAssemblyData option * TypedImplFile list option * BoundModel) * DateTime)> - } - -[] -type IncrementalBuilderInitialState = - { - initialBoundModel: BoundModel - tcGlobals: TcGlobals - nonFrameworkAssemblyInputs: (Choice * (TimeStampCache -> DateTime)) list - tcConfig: TcConfig - outfile: string - assemblyName: string - lexResourceManager: Lexhelp.LexResourceManager - sourceFiles: (range * string * (bool * bool)) list - enablePartialTypeChecking: bool - beforeFileChecked: Event - fileChecked: Event - fileParsed: Event - projectChecked: Event -#if !NO_EXTENSIONTYPING - importsInvalidatedByTypeProvider: Event -#endif - allDependencies: string [] - defaultTimeStamp: DateTime - mutable isImportsInvalidated: bool - } - - static member Create( - initialBoundModel: BoundModel, - tcGlobals, - nonFrameworkAssemblyInputs, - tcConfig: TcConfig, - outfile, - assemblyName, - lexResourceManager, - sourceFiles, - enablePartialTypeChecking, - beforeFileChecked: Event, - fileChecked: Event, -#if !NO_EXTENSIONTYPING - importsInvalidatedByTypeProvider: Event, -#endif - allDependencies, - defaultTimeStamp: DateTime) = - - let initialState = - { - initialBoundModel = initialBoundModel - tcGlobals = tcGlobals - nonFrameworkAssemblyInputs = nonFrameworkAssemblyInputs - tcConfig = tcConfig - outfile = outfile - assemblyName = assemblyName - lexResourceManager = lexResourceManager - sourceFiles = sourceFiles - enablePartialTypeChecking = enablePartialTypeChecking - beforeFileChecked = beforeFileChecked - fileChecked = fileChecked - fileParsed = Event() - projectChecked = Event() -#if !NO_EXTENSIONTYPING - importsInvalidatedByTypeProvider = importsInvalidatedByTypeProvider -#endif - allDependencies = allDependencies - defaultTimeStamp = defaultTimeStamp - isImportsInvalidated = false - } -#if !NO_EXTENSIONTYPING - importsInvalidatedByTypeProvider.Publish.Add(fun () -> initialState.isImportsInvalidated <- true) -#endif - initialState - -/// Manages an incremental build graph for the build of a single F# project -type IncrementalBuilder(initialState: IncrementalBuilderInitialState) = - - let initialBoundModel = initialState.initialBoundModel - let tcGlobals = initialState.tcGlobals - let nonFrameworkAssemblyInputs = initialState.nonFrameworkAssemblyInputs - let tcConfig = initialState.tcConfig - let outfile = initialState.outfile - let assemblyName = initialState.assemblyName - let lexResourceManager = initialState.lexResourceManager - let sourceFiles = initialState.sourceFiles - let enablePartialTypeChecking = initialState.enablePartialTypeChecking - let beforeFileChecked = initialState.beforeFileChecked - let fileChecked = initialState.fileChecked -#if !NO_EXTENSIONTYPING - let importsInvalidatedByTypeProvider = initialState.importsInvalidatedByTypeProvider -#endif - let allDependencies = initialState.allDependencies - let defaultTimeStamp = initialState.defaultTimeStamp - let fileParsed = initialState.fileParsed - let projectChecked = initialState.projectChecked - - //---------------------------------------------------- - // START OF BUILD TASK FUNCTIONS +[] +module IncrementalBuilderHelpers = /// Get the timestamp of the given file name. let StampFileNameTask (cache: TimeStampCache) (_m: range, filename: string, _isLastCompiland) = @@ -817,7 +713,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState) = timeStamper cache // Link all the assemblies together and produce the input typecheck accumulator - static let CombineImportedAssembliesTask ( + let CombineImportedAssembliesTask ( assemblyName, tcConfig: TcConfig, tcConfigP, @@ -929,7 +825,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState) = } /// Finish up the typechecking to produce outputs for the rest of the compilation process - let FinalizeTypeCheckTask (boundModels: ImmutableArray) = + let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals enablePartialTypeChecking assemblyName outfile (boundModels: block) = node { let errorLogger = CompilationErrorLogger("FinalizeTypeCheckTask", tcConfig.errorSeverityOptions) use _ = new CompilationGlobalsScope(errorLogger, BuildPhase.TypeCheck) @@ -1017,53 +913,134 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState) = return ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt, finalBoundModelWithErrors } - // END OF BUILD TASK FUNCTIONS - // --------------------------------------------------------------------------------------------- + let GetSyntaxTree tcConfig fileParsed lexResourceManager (sourceRange: range, filename: string, isLastCompiland) = + SyntaxTree(tcConfig, fileParsed, lexResourceManager, sourceRange, filename, isLastCompiland) - // --------------------------------------------------------------------------------------------- - // START OF BUILD DESCRIPTION +[] +type IncrementalBuilderInitialState = + { + initialBoundModel: BoundModel + tcGlobals: TcGlobals + referencedAssemblies: block<(Choice * (TimeStampCache -> DateTime))> + tcConfig: TcConfig + outfile: string + assemblyName: string + lexResourceManager: Lexhelp.LexResourceManager + fileNames: block<(range * string * (bool * bool))> + enablePartialTypeChecking: bool + beforeFileChecked: Event + fileChecked: Event + fileParsed: Event + projectChecked: Event +#if !NO_EXTENSIONTYPING + importsInvalidatedByTypeProvider: Event +#endif + allDependencies: string [] + defaultTimeStamp: DateTime + mutable isImportsInvalidated: bool + } - let GetSyntaxTree (sourceRange: range, filename: string, isLastCompiland) = - SyntaxTree(tcConfig, fileParsed, lexResourceManager, sourceRange, filename, isLastCompiland) + static member Create( + initialBoundModel: BoundModel, + tcGlobals, + nonFrameworkAssemblyInputs, + tcConfig: TcConfig, + outfile, + assemblyName, + lexResourceManager, + sourceFiles, + enablePartialTypeChecking, + beforeFileChecked: Event, + fileChecked: Event, +#if !NO_EXTENSIONTYPING + importsInvalidatedByTypeProvider: Event, +#endif + allDependencies, + defaultTimeStamp: DateTime) = - // Inputs - let fileNames = sourceFiles |> Array.ofList // TODO: This should be an immutable array. - let referencedAssemblies = nonFrameworkAssemblyInputs |> Array.ofList // TODO: This should be an immutable array. + let initialState = + { + initialBoundModel = initialBoundModel + tcGlobals = tcGlobals + referencedAssemblies = nonFrameworkAssemblyInputs |> Block.ofSeq + tcConfig = tcConfig + outfile = outfile + assemblyName = assemblyName + lexResourceManager = lexResourceManager + fileNames = sourceFiles |> Block.ofSeq + enablePartialTypeChecking = enablePartialTypeChecking + beforeFileChecked = beforeFileChecked + fileChecked = fileChecked + fileParsed = Event() + projectChecked = Event() +#if !NO_EXTENSIONTYPING + importsInvalidatedByTypeProvider = importsInvalidatedByTypeProvider +#endif + allDependencies = allDependencies + defaultTimeStamp = defaultTimeStamp + isImportsInvalidated = false + } +#if !NO_EXTENSIONTYPING + importsInvalidatedByTypeProvider.Publish.Add(fun () -> initialState.isImportsInvalidated <- true) +#endif + initialState - let createBoundModelGraphNode initialBoundModel (boundModels: ImmutableArray>.Builder) i = - let fileInfo = fileNames.[i] +[] +type IncrementalBuilderState = + { + // stampedFileNames represent the real stamps of the files. + // logicalStampedFileNames represent the stamps of the files that are used to calculate the project's logical timestamp. + stampedFileNames: block + logicalStampedFileNames: block + stampedReferencedAssemblies: block + initialBoundModel: GraphNode + boundModels: block> + finalizedBoundModel: GraphNode<((ILAssemblyRef * IRawFSharpAssemblyData option * TypedImplFile list option * BoundModel) * DateTime)> + } + +[] +module IncrementalBuilderStateHelpers = + + let createBoundModelGraphNode (initialState: IncrementalBuilderInitialState) initialBoundModel (boundModels: blockbuilder>) i = + let fileInfo = initialState.fileNames.[i] let prevBoundModelGraphNode = match i with | 0 (* first file *) -> initialBoundModel | _ -> boundModels.[i - 1] - let syntaxTree = GetSyntaxTree fileInfo + let syntaxTree = GetSyntaxTree initialState.tcConfig initialState.fileParsed initialState.lexResourceManager fileInfo GraphNode(node { let! prevBoundModel = prevBoundModelGraphNode.GetOrComputeValue() - return! TypeCheckTask enablePartialTypeChecking prevBoundModel syntaxTree + return! TypeCheckTask initialState.enablePartialTypeChecking prevBoundModel syntaxTree }) - let rec createFinalizeBoundModelGraphNode (boundModels: ImmutableArray>.Builder) = + let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: blockbuilder>) = GraphNode(node { // Compute last bound model then get all the evaluated models. let! _ = boundModels.[boundModels.Count - 1].GetOrComputeValue() let boundModels = - boundModels - |> Seq.map (fun x -> x.TryPeekValue().Value) - |> ImmutableArray.CreateRange - - let! result = FinalizeTypeCheckTask boundModels + boundModels.ToImmutable() + |> Block.map (fun x -> x.TryPeekValue().Value) + + let! result = + FinalizeTypeCheckTask + initialState.tcConfig + initialState.tcGlobals + initialState.enablePartialTypeChecking + initialState.assemblyName + initialState.outfile + boundModels let result = (result, DateTime.UtcNow) return result }) - and computeStampedFileName (state: IncrementalBuilderState) (cache: TimeStampCache) slot fileInfo = + and computeStampedFileName (initialState: IncrementalBuilderInitialState) (state: IncrementalBuilderState) (cache: TimeStampCache) slot fileInfo = let currentStamp = state.stampedFileNames.[slot] let stamp = StampFileNameTask cache fileInfo if currentStamp <> stamp then match state.boundModels.[slot].TryPeekValue() with // This prevents an implementation file that has a backing signature file from invalidating the rest of the build. - | ValueSome(boundModel) when enablePartialTypeChecking && boundModel.BackingSignature.IsSome -> + | ValueSome(boundModel) when initialState.enablePartialTypeChecking && boundModel.BackingSignature.IsSome -> let newBoundModel = boundModel.ClearTcInfoExtras() { state with boundModels = state.boundModels.RemoveAt(slot).Insert(slot, GraphNode(node { return newBoundModel })) @@ -1077,14 +1054,14 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState) = // Invalidate the file and all files below it. for j = 0 to stampedFileNames.Count - slot - 1 do - let stamp = StampFileNameTask cache fileNames.[slot + j] + let stamp = StampFileNameTask cache initialState.fileNames.[slot + j] stampedFileNames.[slot + j] <- stamp logicalStampedFileNames.[slot + j] <- stamp - boundModels.[slot + j] <- createBoundModelGraphNode state.initialBoundModel boundModels (slot + j) + boundModels.[slot + j] <- createBoundModelGraphNode initialState state.initialBoundModel boundModels (slot + j) { state with // Something changed, the finalized view of the project must be invalidated. - finalizedBoundModel = createFinalizeBoundModelGraphNode boundModels + finalizedBoundModel = createFinalizeBoundModelGraphNode initialState boundModels stampedFileNames = stampedFileNames.ToImmutable() logicalStampedFileNames = logicalStampedFileNames.ToImmutable() @@ -1093,21 +1070,21 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState) = else state - and computeStampedFileNames state (cache: TimeStampCache) = + and computeStampedFileNames (initialState: IncrementalBuilderInitialState) state (cache: TimeStampCache) = let mutable i = 0 - (state, fileNames) - ||> Array.fold (fun state fileInfo -> - let newState = computeStampedFileName state cache i fileInfo + (state, initialState.fileNames) + ||> Block.fold (fun state fileInfo -> + let newState = computeStampedFileName initialState state cache i fileInfo i <- i + 1 newState ) - and computeStampedReferencedAssemblies state canTriggerInvalidation (cache: TimeStampCache) = + and computeStampedReferencedAssemblies (initialState: IncrementalBuilderInitialState) state canTriggerInvalidation (cache: TimeStampCache) = let stampedReferencedAssemblies = state.stampedReferencedAssemblies.ToBuilder() let mutable referencesUpdated = false - referencedAssemblies - |> Array.iteri (fun i asmInfo -> + initialState.referencedAssemblies + |> Block.iteri (fun i asmInfo -> let currentStamp = state.stampedReferencedAssemblies.[i] let stamp = StampReferencedAssemblyTask cache asmInfo @@ -1127,6 +1104,55 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState) = else state +type IncrementalBuilderState with + + (* + The data below represents a dependency graph. + + ReferencedAssembliesStamps => FileStamps => BoundModels => FinalizedBoundModel + *) + static member Create(initialState: IncrementalBuilderInitialState) = + let defaultTimeStamp = initialState.defaultTimeStamp + let initialBoundModel = initialState.initialBoundModel + let fileNames = initialState.fileNames + let referencedAssemblies = initialState.referencedAssemblies + + let cache = TimeStampCache(defaultTimeStamp) + let initialBoundModel = GraphNode(node { return initialBoundModel }) + let boundModels = BlockBuilder.create fileNames.Length + + for slot = 0 to fileNames.Length - 1 do + boundModels.Add(createBoundModelGraphNode initialState initialBoundModel boundModels slot) + + let state = + { + stampedFileNames = Block.init fileNames.Length (fun _ -> DateTime.MinValue) + logicalStampedFileNames = Block.init fileNames.Length (fun _ -> DateTime.MinValue) + stampedReferencedAssemblies = Block.init referencedAssemblies.Length (fun _ -> DateTime.MinValue) + initialBoundModel = initialBoundModel + boundModels = boundModels.ToImmutable() + finalizedBoundModel = createFinalizeBoundModelGraphNode initialState boundModels + } + let state = computeStampedReferencedAssemblies initialState state false cache + let state = computeStampedFileNames initialState state cache + state + +/// Manages an incremental build graph for the build of a single F# project +type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: IncrementalBuilderState) = + + let initialBoundModel = initialState.initialBoundModel + let tcConfig = initialState.tcConfig + let fileNames = initialState.fileNames + let beforeFileChecked = initialState.beforeFileChecked + let fileChecked = initialState.fileChecked +#if !NO_EXTENSIONTYPING + let importsInvalidatedByTypeProvider = initialState.importsInvalidatedByTypeProvider +#endif + let allDependencies = initialState.allDependencies + let defaultTimeStamp = initialState.defaultTimeStamp + let fileParsed = initialState.fileParsed + let projectChecked = initialState.projectChecked + let tryGetSlot (state: IncrementalBuilderState) slot = match state.boundModels.[slot].TryPeekValue() with | ValueSome boundModel -> @@ -1159,46 +1185,18 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState) = stamps |> Seq.max - // END OF BUILD DESCRIPTION - // --------------------------------------------------------------------------------------------- - - (* - The data below represents a dependency graph. - - ReferencedAssembliesStamps => FileStamps => BoundModels => FinalizedBoundModel - *) - - let gate = obj () - let mutable currentState = - let cache = TimeStampCache(defaultTimeStamp) - let initialBoundModel = GraphNode(node { return initialBoundModel }) - let boundModels = ImmutableArray.CreateBuilder(fileNames.Length) - - for slot = 0 to fileNames.Length - 1 do - boundModels.Add(createBoundModelGraphNode initialBoundModel boundModels slot) - - let state = - { - stampedFileNames = Array.init fileNames.Length (fun _ -> DateTime.MinValue) |> ImmutableArray.CreateRange - logicalStampedFileNames = Array.init fileNames.Length (fun _ -> DateTime.MinValue) |> ImmutableArray.CreateRange - stampedReferencedAssemblies = Array.init referencedAssemblies.Length (fun _ -> DateTime.MinValue) |> ImmutableArray.CreateRange - initialBoundModel = initialBoundModel - boundModels = boundModels.ToImmutable() - finalizedBoundModel = createFinalizeBoundModelGraphNode boundModels - } - let state = computeStampedReferencedAssemblies state false cache - let state = computeStampedFileNames state cache - state - let computeProjectTimeStamp (state: IncrementalBuilderState) = let t1 = MaxTimeStampInDependencies state.stampedReferencedAssemblies let t2 = MaxTimeStampInDependencies state.logicalStampedFileNames max t1 t2 + let gate = obj() + let mutable currentState = state + let setCurrentState state cache (ct: CancellationToken) = lock gate (fun () -> ct.ThrowIfCancellationRequested() - currentState <- computeStampedFileNames state cache + currentState <- computeStampedFileNames initialState state cache ) let checkFileTimeStamps (cache: TimeStampCache) = @@ -1227,7 +1225,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState) = // fast path if initialState.isImportsInvalidated then true else - computeStampedReferencedAssemblies currentState true (TimeStampCache(defaultTimeStamp)) |> ignore + computeStampedReferencedAssemblies initialState currentState true (TimeStampCache(defaultTimeStamp)) |> ignore initialState.isImportsInvalidated member _.AllDependenciesDeprecated = allDependencies @@ -1258,7 +1256,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState) = member builder.TryGetCheckResultsBeforeFileInProject (filename) = let cache = TimeStampCache defaultTimeStamp - let tmpState = computeStampedFileNames currentState cache + let tmpState = computeStampedFileNames initialState currentState cache let slotOfFile = builder.GetSlotOfFileName filename match tryGetBeforeSlot tmpState slotOfFile with @@ -1331,7 +1329,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState) = } member _.GetLogicalTimeStampForProject(cache) = - let tmpState = computeStampedFileNames currentState cache + let tmpState = computeStampedFileNames initialState currentState cache computeProjectTimeStamp tmpState member _.TryGetSlotOfFileName(filename: string) = @@ -1341,7 +1339,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState) = String.Compare(filename, f2, StringComparison.CurrentCultureIgnoreCase)=0 || String.Compare(FileSystem.GetFullPathShim filename, FileSystem.GetFullPathShim f2, StringComparison.CurrentCultureIgnoreCase)=0 result - match fileNames |> Array.tryFindIndex CompareFileNames with + match fileNames |> Seq.tryFindIndex CompareFileNames with | Some slot -> Some slot | None -> None @@ -1359,10 +1357,10 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState) = let slotOfFile = builder.GetSlotOfFileName filename let fileInfo = fileNames.[slotOfFile] // re-parse on demand instead of retaining - let syntaxTree = GetSyntaxTree fileInfo + let syntaxTree = GetSyntaxTree initialState.tcConfig initialState.fileParsed initialState.lexResourceManager fileInfo syntaxTree.Parse None - member _.SourceFiles = sourceFiles |> List.map (fun (_, f, _) -> f) + member _.SourceFiles = fileNames |> Seq.map (fun (_, f, _) -> f) |> List.ofSeq /// CreateIncrementalBuilder (for background type checking). Note that fsc.fs also /// creates an incremental builder used by the command line compiler. @@ -1607,7 +1605,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState) = allDependencies, defaultTimeStamp) - let builder = IncrementalBuilder(initialState) + let builder = IncrementalBuilder(initialState, IncrementalBuilderState.Create(initialState)) return Some builder with e -> errorRecoveryNoRange e diff --git a/tests/FSharp.Compiler.UnitTests/BlockTests.fs b/tests/FSharp.Compiler.UnitTests/BlockTests.fs new file mode 100644 index 00000000000..e4f4bdd29fd --- /dev/null +++ b/tests/FSharp.Compiler.UnitTests/BlockTests.fs @@ -0,0 +1,58 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +namespace FSharp.Compiler.UnitTests + +open Xunit +open FSharp.Test.Utilities +open Internal.Utilities.Library + +module BlockTests = + + [] + let ``Iter should work correctly``() = + let b = Block.init 5 id + + let results = ResizeArray() + b + |> Block.iter (fun x -> + results.Add(x) + ) + + Assert.Equal( + [ + 0 + 1 + 2 + 3 + 4 + ], + results + ) + + [] + let ``Map should work correctly``() = + let b = Block.init 5 id + + let b2 = b |> Block.map (fun x -> x + 1) + + Assert.Equal( + [ + 1 + 2 + 3 + 4 + 5 + ], + b2 + ) + + [] + let ``Fold should work correctly``() = + let b = Block.init 5 id + + let result = + (0, b) + ||> Block.fold (fun state n -> + state + n + ) + + Assert.Equal(10, result) \ No newline at end of file diff --git a/tests/FSharp.Compiler.UnitTests/FSharp.Compiler.UnitTests.fsproj b/tests/FSharp.Compiler.UnitTests/FSharp.Compiler.UnitTests.fsproj index c3d3ca35aec..dda54a28a49 100644 --- a/tests/FSharp.Compiler.UnitTests/FSharp.Compiler.UnitTests.fsproj +++ b/tests/FSharp.Compiler.UnitTests/FSharp.Compiler.UnitTests.fsproj @@ -24,6 +24,7 @@ + From 33b649397d8a25d3072ce659bb2af37ca9529b4e Mon Sep 17 00:00:00 2001 From: Will Smith Date: Tue, 29 Jun 2021 15:01:24 -0700 Subject: [PATCH 4/6] using block --- src/fsharp/service/IncrementalBuild.fs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 1495c3fe0c3..f4267b9d5e6 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -832,7 +832,7 @@ module IncrementalBuilderHelpers = let! results = boundModels - |> Seq.map (fun boundModel -> node { + |> Block.map (fun boundModel -> node { if enablePartialTypeChecking then let! tcInfo = boundModel.GetOrComputeTcInfo() return tcInfo, None @@ -840,7 +840,7 @@ module IncrementalBuilderHelpers = let! tcInfo, tcInfoExtras = boundModel.GetOrComputeTcInfoWithExtras() return tcInfo, tcInfoExtras.latestImplFile }) - |> Seq.map (fun work -> + |> Block.map (fun work -> node { let! tcInfo, latestImplFile = work return (tcInfo.tcEnvAtEndOfFile, defaultArg tcInfo.topAttribs EmptyTopAttrs, latestImplFile, tcInfo.latestCcuSigForFile) @@ -1339,7 +1339,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc String.Compare(filename, f2, StringComparison.CurrentCultureIgnoreCase)=0 || String.Compare(FileSystem.GetFullPathShim filename, FileSystem.GetFullPathShim f2, StringComparison.CurrentCultureIgnoreCase)=0 result - match fileNames |> Seq.tryFindIndex CompareFileNames with + match fileNames |> Block.tryFindIndex CompareFileNames with | Some slot -> Some slot | None -> None @@ -1399,7 +1399,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc let tcConfigB, sourceFiles = let getSwitchValue switchString = - match commandLineArgs |> Seq.tryFindIndex(fun s -> s.StartsWithOrdinal switchString) with + match commandLineArgs |> List.tryFindIndex(fun s -> s.StartsWithOrdinal switchString) with | Some idx -> Some(commandLineArgs.[idx].Substring(switchString.Length)) | _ -> None From a83952ac5141867c2dd5193f0469d1a5570a9f62 Mon Sep 17 00:00:00 2001 From: Will Smith Date: Thu, 1 Jul 2021 10:57:33 -0700 Subject: [PATCH 5/6] Block feedback --- src/fsharp/block.fs | 137 ++++++++++++++++--------------------------- src/fsharp/block.fsi | 1 + 2 files changed, 52 insertions(+), 86 deletions(-) diff --git a/src/fsharp/block.fs b/src/fsharp/block.fs index 2e43c11d80d..cc0dbbf1c58 100644 --- a/src/fsharp/block.fs +++ b/src/fsharp/block.fs @@ -9,14 +9,12 @@ type blockbuilder<'T> = ImmutableArray<'T>.Builder module BlockBuilder = let create size : blockbuilder<'T> = - if size = 0 then - ImmutableArray.CreateBuilder() - else - ImmutableArray.CreateBuilder(size) + ImmutableArray.CreateBuilder(size) [] module Block = + [] let empty<'T> = ImmutableArray<'T>.Empty let init n (f: int -> 'T) : block<_> = @@ -30,7 +28,7 @@ module Block = let builder = ImmutableArray.CreateBuilder(n) for i = 0 to n - 1 do builder.Add(f i) - builder.ToImmutable() + builder.MoveToImmutable() let iter f (arr: block<'T>) = for i = 0 to arr.Length - 1 do @@ -56,23 +54,23 @@ module Block = let map (mapper: 'T -> 'U) (arr: block<'T>) : block<_> = match arr.Length with - | 0 -> block.Empty + | 0 -> ImmutableArray.Empty | 1 -> ImmutableArray.Create(mapper arr.[0]) | _ -> let builder = ImmutableArray.CreateBuilder(arr.Length) for i = 0 to arr.Length - 1 do builder.Add(mapper arr.[i]) - builder.ToImmutable() + builder.MoveToImmutable() let mapi (mapper: int -> 'T -> 'U) (arr: block<'T>) : block<_> = match arr.Length with - | 0 -> block.Empty + | 0 -> ImmutableArray.Empty | 1 -> ImmutableArray.Create(mapper 0 arr.[0]) | _ -> let builder = ImmutableArray.CreateBuilder(arr.Length) for i = 0 to arr.Length - 1 do builder.Add(mapper i arr.[i]) - builder.ToImmutable() + builder.MoveToImmutable() let map2 (mapper: 'T1 -> 'T2 -> 'T) (arr1: block<'T1>) (arr2: block<'T2>) : block<_> = if arr1.Length <> arr2.Length then @@ -85,7 +83,7 @@ module Block = let builder = ImmutableArray.CreateBuilder(n) for i = 0 to n - 1 do builder.Add(mapper arr1.[i] arr2.[i]) - builder.ToImmutable() + builder.MoveToImmutable() let mapi2 (mapper: int -> 'T1 -> 'T2 -> 'T) (arr1: block<'T1>) (arr2: block<'T2>) : block<_> = if arr1.Length <> arr2.Length then @@ -98,85 +96,55 @@ module Block = let builder = ImmutableArray.CreateBuilder(n) for i = 0 to n - 1 do builder.Add(mapper i arr1.[i] arr2.[i]) - builder.ToImmutable() - - let concat (arr: block>) : block<'T> = - if arr.IsEmpty then - empty - elif arr.Length = 1 then - arr.[0] - elif arr.Length = 2 then - arr.[0].AddRange(arr.[1]) - else - let mutable arr2 = arr.[0] - for i = 1 to arr.Length - 1 do - arr2 <- arr2.AddRange(arr.[i]) - arr2 + builder.MoveToImmutable() + + let concat (arrs: block>) : block<'T> = + match arrs.Length with + | 0 -> ImmutableArray.Empty + | 1 -> arrs.[0] + | 2 -> arrs.[0].AddRange(arrs.[1]) + | _ -> + let mutable acc = 0 + for h in arrs do + acc <- acc + h.Length + + let builder = ImmutableArray.CreateBuilder(acc) + for i = 0 to arrs.Length - 1 do + builder.AddRange(arrs.[i]) + builder.MoveToImmutable() let forall predicate (arr: block<'T>) = - match arr.Length with - | 0 -> true - | 1 -> predicate arr.[0] - | n -> - let mutable result = true - let mutable i = 0 - while result && i < n do - result <- predicate arr.[i] - i <- i + 1 - result + let len = arr.Length + let rec loop i = i >= len || (predicate arr.[i] && loop (i+1)) + loop 0 let forall2 predicate (arr1: block<'T1>) (arr2: block<'T2>) = if arr1.Length <> arr2.Length then invalidOp "Block lengths do not match." - match arr1.Length with - | 0 -> true - | 1 -> predicate arr1.[0] arr2.[0] - | n -> - let mutable result = true - let mutable i = 0 - while result && i < n do - result <- predicate arr1.[i] arr2.[i] - i <- i + 1 - result + let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(predicate) + let len1 = arr1.Length + let rec loop i = i >= len1 || (f.Invoke(arr1.[i], arr2.[i]) && loop (i+1)) + loop 0 let tryFind predicate (arr: block<'T>) = - match arr.Length with - | 0 -> None - | 1 -> if predicate arr.[0] then Some arr.[0] else None - | n -> - let mutable result = None - let mutable i = 0 - while result.IsNone && i < n do - if predicate arr.[i] then - result <- Some arr.[i] - i <- i + 1 - result + let rec loop i = + if i >= arr.Length then None else + if predicate arr.[i] then Some arr.[i] else loop (i+1) + loop 0 let tryFindIndex predicate (arr: block<'T>) = - match arr.Length with - | 0 -> None - | 1 -> if predicate arr.[0] then Some 0 else None - | n -> - let mutable result = None - let mutable i = 0 - while result.IsNone && i < n do - if predicate arr.[i] then - result <- Some i - i <- i + 1 - result + let len = arr.Length + let rec go n = if n >= len then None elif predicate arr.[n] then Some n else go (n+1) + go 0 let tryPick chooser (arr: block<'T>) = - match arr.Length with - | 0 -> None - | 1 -> chooser arr.[0] - | n -> - let mutable result = None - let mutable i = 0 - while result.IsNone && i < n do - result <- chooser arr.[i] - i <- i + 1 - result + let rec loop i = + if i >= arr.Length then None else + match chooser arr.[i] with + | None -> loop(i+1) + | res -> res + loop 0 let ofSeq (xs: 'T seq) = ImmutableArray.CreateRange(xs) @@ -192,17 +160,13 @@ module Block = for i = 0 to arr.Length - 1 do if predicate arr.[i] then builder.Add(arr.[i]) - builder.ToImmutable() + builder.Capacity <- builder.Count + builder.MoveToImmutable() let exists predicate (arr: block<'T>) = - let n = arr.Length - let mutable result = false - let mutable i = 0 - while not result && i < n do - if predicate arr.[i] then - result <- true - i <- i + 1 - result + let len = arr.Length + let rec loop i = i < len && (predicate arr.[i] || loop (i+1)) + len > 0 && loop 0 let choose (chooser: 'T -> 'U option) (arr: block<'T>) : block<'U> = let builder = ImmutableArray.CreateBuilder(arr.Length) @@ -210,7 +174,8 @@ module Block = let result = chooser arr.[i] if result.IsSome then builder.Add(result.Value) - builder.ToImmutable() + builder.Capacity <- builder.Count + builder.MoveToImmutable() let isEmpty (arr: block<_>) = arr.Length = 0 diff --git a/src/fsharp/block.fsi b/src/fsharp/block.fsi index 9790dabaa50..ec7ef7fa5a0 100644 --- a/src/fsharp/block.fsi +++ b/src/fsharp/block.fsi @@ -17,6 +17,7 @@ module BlockBuilder = [] module Block = + [] val empty<'T> : block<'T> val init : n: int -> f: (int -> 'T) -> block<'T> From 0a78706736a6ecef1915c3ad10861f9c678de60f Mon Sep 17 00:00:00 2001 From: Will Smith Date: Thu, 1 Jul 2021 11:02:01 -0700 Subject: [PATCH 6/6] Use IsEmpty --- src/fsharp/block.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/block.fs b/src/fsharp/block.fs index cc0dbbf1c58..ca74049032f 100644 --- a/src/fsharp/block.fs +++ b/src/fsharp/block.fs @@ -177,7 +177,7 @@ module Block = builder.Capacity <- builder.Count builder.MoveToImmutable() - let isEmpty (arr: block<_>) = arr.Length = 0 + let isEmpty (arr: block<_>) = arr.IsEmpty let fold folder state (arr: block<_>) = let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(folder)