forked from dotnet/fsharp
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
1 parent
b00ed8a
commit 66c747e
Showing
5 changed files
with
239 additions
and
28 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,18 @@ | ||
| module FSharp.Compiler.Service.Tests.Utils | ||
|
|
||
| #nowarn "40" | ||
|
|
||
| open System.Collections.Concurrent | ||
| open System.Collections.Generic | ||
|
|
||
| let memoize<'a, 'b when 'a : equality> f : ('a -> 'b) = | ||
| let y = HashIdentity.Structural<'a> | ||
| let d = new ConcurrentDictionary<'a, 'b>(y) | ||
| fun x -> d.GetOrAdd(x, fun r -> f r) | ||
|
|
||
| type FileIdx = | ||
| FileIdx of int | ||
| with | ||
| member this.Idx = match this with FileIdx idx -> idx | ||
| override this.ToString() = this.Idx.ToString() | ||
| static member make (idx : int) = FileIdx idx |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,205 @@ | ||
| module FSharp.Compiler.Service.Tests.code | ||
|
|
||
| open System.Collections.Generic | ||
| open FSharp.Compiler.Service.Tests.Graph | ||
| open FSharp.Compiler.Syntax | ||
| type AST = FSharp.Compiler.Syntax.ParsedInput | ||
|
|
||
| type FileName = FileName of string | ||
| with member this.FileName = match this with FileName fileName -> fileName | ||
|
|
||
| /// Input from the compiler after parsing | ||
| [<CustomEquality; NoComparison>] | ||
| type SourceFile = | ||
| { | ||
| Name : string | ||
| AST : AST | ||
| } | ||
| // custom check - compare against CustomerId only | ||
| override this.Equals other = | ||
| match other with | ||
| | :? SourceFile as p -> p.Name.Equals this.Name | ||
| | _ -> false | ||
| // custom hash check | ||
| override this.GetHashCode () = this.Name.GetHashCode() | ||
|
|
||
| type SourceFiles = SourceFile[] | ||
| type FsiInfo = | ||
| | FsiBacked | ||
| | NotBacked | ||
| with member this.IsFsiBacked = | ||
| match this with | ||
| | FsiBacked -> true | ||
| | NotBacked -> false | ||
|
|
||
| type File = | ||
| { | ||
| File : SourceFile | ||
| FsiInfo : FsiInfo | ||
| } | ||
| type Files = File[] | ||
| type FileGraph = Graph<File> | ||
|
|
||
| let gatherBackingInfo (files : SourceFiles) : Files = | ||
| let seenSigFiles = HashSet<string>() | ||
| files | ||
| |> Array.map (fun f -> | ||
| let fsiInfo = | ||
| match f.AST with | ||
| | ParsedInput.SigFile _ -> | ||
| NotBacked | ||
| | ParsedInput.ImplFile _ -> | ||
| let fsiName = System.IO.Path.ChangeExtension(f.Name, "fsi") | ||
| match seenSigFiles.Contains fsiName with | ||
| | true -> FsiBacked | ||
| | false -> NotBacked | ||
| { | ||
| File = f | ||
| FsiInfo = fsiInfo | ||
| } | ||
| ) | ||
|
|
||
| type EdgeTrimmer = File -> File -> bool | ||
|
|
||
| type FileData = | ||
| { | ||
| ModuleRefs : ModuleRef[] | ||
| Structure : FileStructure | ||
| } | ||
|
|
||
| let gatherFileData (file : File) = | ||
|
|
||
| let calcFileGraph (files : SourceFiles) : FileGraph = | ||
| let fsFsiTrimmer = | ||
| let files = | ||
| gatherBackingInfo files | ||
| ... to dict | ||
| fun file dep -> not files[dep].FsiInfo.IsFsiBacked | ||
| let | ||
|
|
||
| /// Used for processing | ||
| type NodeInfo<'Item> = | ||
| { | ||
| Item : 'Item | ||
| Deps : 'Item[] | ||
| TransitiveDeps : 'Item[] | ||
| Dependants : 'Item[] | ||
| ProcessedDepsCount : int | ||
| } | ||
| type Node<'Item, 'State, 'Result> = | ||
| { | ||
| Info : NodeInfo<'Item> | ||
| Result : ('State * 'Result) option | ||
| } | ||
|
|
||
| // Do we need to suppress some error logging if we | ||
| // apply the same partial results multiple times? | ||
| // Maybe we can enable logging only for the final fold | ||
| let combineResults | ||
| (deps : Node<_,_,_>[]) | ||
| (transitiveDeps : Node<_,_,_>[]) | ||
| (folder : 'State -> 'Result -> 'State) | ||
| : 'State | ||
| = | ||
| let biggestDep = | ||
| let sizeMetric node = | ||
| // Could also use eg. total file size/AST size | ||
| node.Info.TransitiveDeps.Length | ||
| deps | ||
| |> Array.maxBy sizeMetrix | ||
| let firstState = snd biggestDep.Result | ||
| // Perf: Keep transDeps in a HashSet from the start | ||
| let included = HashSet(firstState.Info.TransitiveDeps) | ||
| let toAdd = | ||
| transitiveDeps | ||
| |> Array.filter (fun dep -> included.Add dep) | ||
| let state = Array.fold folder firstState toAdd | ||
| state | ||
|
|
||
| let processInParallel | ||
| (firstItems : 'Item[]) | ||
| (work : 'Item -> 'Item[]) | ||
| (parallelism : int) | ||
| (stop : int -> bool) | ||
| (ct) | ||
| : unit async | ||
| = | ||
| let bc = BlockingCollection(firstItems) | ||
| let mutable processedCount = 0 | ||
| let processItem item = | ||
| let toSchedule = work item | ||
| lock processedCount (fun () -> processedCount++) | ||
| toSchedule |> Array.iter bc.Add | ||
| // Could avoid workers with some semaphores | ||
| let workerWork () = | ||
| for node in bc.Get... do | ||
| if not ct.Cancelled then // improve | ||
| processNode node | ||
| if stop () then | ||
| bc.CompleteAdding() // avoid doing multiple times? | ||
|
|
||
| Array.Parallel.map | ||
| parallelism workerWork // use cancellation | ||
|
|
||
| let processGraph | ||
| (graph : FileGraph) | ||
| (doWork : 'Item -> 'State -> 'Result * 'State) | ||
| (folder : 'State -> 'Result -> 'State) | ||
| (parallelism : int) | ||
| : 'State | ||
| = | ||
| let transitiveDeps = graph |> calcTransitiveGraph | ||
| let dependants = graph |> reverseGraph | ||
| let nodes = graph.Keys |> Seq.map ... | ||
| let leaves = nodes |> Seq.filter ... | ||
| let work | ||
| (node : Node<'Item, 'State, 'Result>) | ||
| : Node<'Item, 'State, 'Result>[] | ||
| = | ||
| let inputState = combineResults node.Deps node.TransitiveDeps folder | ||
| let res = doWork node.Info.Item | ||
| node.Result <- res | ||
| let unblocked = | ||
| node.Info.Dependants | ||
| |> Array.filter (fun x -> | ||
| let pdc = | ||
| lock x (fun () -> | ||
| x.Info.ProcessedDepsCount++ | ||
| x.Info.PrcessedDepsCount | ||
| ) | ||
| pdc = node.Info.Deps.Length | ||
| ) | ||
| |> Array.map (fun x -> nodes[x]) | ||
| unblocked | ||
|
|
||
| processInParallel | ||
| leaves | ||
| work | ||
| parallelism | ||
| (fun processedCount -> processedCount = nodes.Length) | ||
|
|
||
| let state = combineResults nodes nodes addCheckResultsToTcState | ||
| state | ||
|
|
||
| type TcState | ||
| type SingleResult | ||
|
|
||
| let typeCheckFile (file : File) (state : TcState) | ||
| : SingleResult * TcState | ||
| = | ||
| ... | ||
|
|
||
| let typeCheckGraph (graph : FileGraph) : TcState = | ||
| let parallelism = 4 // cpu count? | ||
| let state = | ||
| processGraph | ||
| graph | ||
| typeCheckFile | ||
| addCheckResultsToTcState | ||
| parallelism | ||
| state | ||
|
|
||
| let typeCheck (files : SourceFiles) : TcState = | ||
| let graph = calcFileGraph files | ||
| let state = typeCheckGraph graph | ||
| state |