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..ca74049032f --- /dev/null +++ b/src/fsharp/block.fs @@ -0,0 +1,187 @@ +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> = + 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.MoveToImmutable() + + 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 -> 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.MoveToImmutable() + + let mapi (mapper: int -> 'T -> 'U) (arr: block<'T>) : block<_> = + match arr.Length with + | 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.MoveToImmutable() + + 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.MoveToImmutable() + + 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.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>) = + 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." + + 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>) = + 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>) = + 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>) = + 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) + + 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.Capacity <- builder.Count + builder.MoveToImmutable() + + let exists predicate (arr: block<'T>) = + 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) + for i = 0 to arr.Length - 1 do + let result = chooser arr.[i] + if result.IsSome then + builder.Add(result.Value) + builder.Capacity <- builder.Count + builder.MoveToImmutable() + + let isEmpty (arr: block<_>) = arr.IsEmpty + + 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..ec7ef7fa5a0 --- /dev/null +++ b/src/fsharp/block.fsi @@ -0,0 +1,63 @@ +[] +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 828c553e4e9..f4267b9d5e6 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -701,48 +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)> - } - -/// 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, -#if !NO_EXTENSIONTYPING - importsInvalidatedByTypeProvider: Event, -#endif - allDependencies, - defaultTimeStamp: DateTime) = - - let fileParsed = new Event() - let projectChecked = new Event() - - let mutable isImportsInvalidated = false - -#if !NO_EXTENSIONTYPING - do importsInvalidatedByTypeProvider.Publish.Add(fun () -> isImportsInvalidated <- true) -#endif - - //---------------------------------------------------- - // START OF BUILD TASK FUNCTIONS +[] +module IncrementalBuilderHelpers = /// Get the timestamp of the given file name. let StampFileNameTask (cache: TimeStampCache) (_m: range, filename: string, _isLastCompiland) = @@ -753,7 +713,7 @@ type IncrementalBuilder( timeStamper cache // Link all the assemblies together and produce the input typecheck accumulator - static let CombineImportedAssembliesTask ( + let CombineImportedAssembliesTask ( assemblyName, tcConfig: TcConfig, tcConfigP, @@ -865,14 +825,14 @@ type IncrementalBuilder( } /// 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) let! results = boundModels - |> Seq.map (fun boundModel -> node { + |> Block.map (fun boundModel -> node { if enablePartialTypeChecking then let! tcInfo = boundModel.GetOrComputeTcInfo() return tcInfo, None @@ -880,7 +840,7 @@ type IncrementalBuilder( 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) @@ -953,53 +913,134 @@ type IncrementalBuilder( 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) = + + 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 - // 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. +[] +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 initialBoundModel (boundModels: ImmutableArray>.Builder) i = - let fileInfo = fileNames.[i] + 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 })) @@ -1013,14 +1054,14 @@ type IncrementalBuilder( // 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() @@ -1029,21 +1070,21 @@ type IncrementalBuilder( 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 @@ -1055,14 +1096,63 @@ type IncrementalBuilder( 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() } 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 -> @@ -1095,46 +1185,18 @@ type IncrementalBuilder( 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) = @@ -1161,10 +1223,10 @@ type IncrementalBuilder( member _.IsReferencesInvalidated = // fast path - if isImportsInvalidated then true + if initialState.isImportsInvalidated then true else - computeStampedReferencedAssemblies currentState true (TimeStampCache(defaultTimeStamp)) |> ignore - isImportsInvalidated + computeStampedReferencedAssemblies initialState currentState true (TimeStampCache(defaultTimeStamp)) |> ignore + initialState.isImportsInvalidated member _.AllDependenciesDeprecated = allDependencies @@ -1194,7 +1256,7 @@ type IncrementalBuilder( 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 @@ -1267,7 +1329,7 @@ type IncrementalBuilder( } member _.GetLogicalTimeStampForProject(cache) = - let tmpState = computeStampedFileNames currentState cache + let tmpState = computeStampedFileNames initialState currentState cache computeProjectTimeStamp tmpState member _.TryGetSlotOfFileName(filename: string) = @@ -1277,7 +1339,7 @@ type IncrementalBuilder( 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 |> Block.tryFindIndex CompareFileNames with | Some slot -> Some slot | None -> None @@ -1295,10 +1357,10 @@ type IncrementalBuilder( 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. @@ -1337,7 +1399,7 @@ type IncrementalBuilder( 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 @@ -1524,8 +1586,8 @@ type IncrementalBuilder( importsInvalidatedByTypeProvider ) - let builder = - new IncrementalBuilder( + let initialState = + IncrementalBuilderInitialState.Create( initialBoundModel, tcGlobals, nonFrameworkAssemblyInputs, @@ -1542,6 +1604,8 @@ type IncrementalBuilder( #endif allDependencies, defaultTimeStamp) + + 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 @@ +