Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Port code to target projects. #36

Merged
merged 3 commits into from
Dec 19, 2022
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
12 changes: 0 additions & 12 deletions FSharp.Compiler.Service.sln
Original file line number Diff line number Diff line change
Expand Up @@ -40,10 +40,6 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution
src\Compiler\FSComp.txt = src\Compiler\FSComp.txt
EndProjectSection
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ParallelTypeCheckingTests", "tests\ParallelTypeCheckingTests\ParallelTypeCheckingTests.fsproj", "{60EDC1C4-5B8B-4211-94CD-4CF5F9E0FC8B}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "DiamondTest", "tests\DiamondTest\DiamondTest.fsproj", "{62288B06-B682-4774-A8A5-A21D677A7C70}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
Expand Down Expand Up @@ -90,14 +86,6 @@ Global
{07CD957A-3C31-4F75-A735-16CE72E1BD71}.Debug|Any CPU.Build.0 = Debug|Any CPU
{07CD957A-3C31-4F75-A735-16CE72E1BD71}.Release|Any CPU.ActiveCfg = Release|Any CPU
{07CD957A-3C31-4F75-A735-16CE72E1BD71}.Release|Any CPU.Build.0 = Release|Any CPU
{60EDC1C4-5B8B-4211-94CD-4CF5F9E0FC8B}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{60EDC1C4-5B8B-4211-94CD-4CF5F9E0FC8B}.Debug|Any CPU.Build.0 = Debug|Any CPU
{60EDC1C4-5B8B-4211-94CD-4CF5F9E0FC8B}.Release|Any CPU.ActiveCfg = Release|Any CPU
{60EDC1C4-5B8B-4211-94CD-4CF5F9E0FC8B}.Release|Any CPU.Build.0 = Release|Any CPU
{62288B06-B682-4774-A8A5-A21D677A7C70}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{62288B06-B682-4774-A8A5-A21D677A7C70}.Debug|Any CPU.Build.0 = Debug|Any CPU
{62288B06-B682-4774-A8A5-A21D677A7C70}.Release|Any CPU.ActiveCfg = Release|Any CPU
{62288B06-B682-4774-A8A5-A21D677A7C70}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
Expand Down
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
[<RequireQualifiedAccess>]
module ParallelTypeCheckingTests.Continuation
module Continuation

let rec sequence<'a, 'ret> (recursions: (('a -> 'ret) -> 'ret) list) (finalContinuation: 'a list -> 'ret) : 'ret =
match recursions with
Expand Down
Original file line number Diff line number Diff line change
@@ -1,7 +1,6 @@
module ParallelTypeCheckingTests.DependencyResolution
module FSharp.Compiler.GraphChecking.DependencyResolution

open FSharp.Compiler.Syntax
open ParallelTypeCheckingTests

// This code just looks for a path in the trie
// It could be cached and is easy to reason about.
Expand Down Expand Up @@ -130,7 +129,7 @@ let indicesUnderNode (node: TrieNode) : Set<int> =
Set.ofList (collect node id)

/// <summary>
/// For a given file's content, find all missing ("ghost") file dependencies that are required to satisfy the type-checker.
/// For a given file's content, find all missing ("ghost") file dependencies that are required to satisfy the type-checker.
/// </summary>
/// <remarks>
/// A "ghost" dependency is a link between files that actually should be avoided.
Expand Down
Original file line number Diff line number Diff line change
@@ -1,8 +1,7 @@
module rec ParallelTypeCheckingTests.FileContentMapping
module rec FSharp.Compiler.GraphChecking.FileContentMapping

open FSharp.Compiler.Syntax
open FSharp.Compiler.SyntaxTreeOps
open ParallelTypeCheckingTests

type Continuations = ((FileContentEntry list -> FileContentEntry list) -> FileContentEntry list) list

Expand Down
Original file line number Diff line number Diff line change
@@ -1,12 +1,11 @@
namespace ParallelTypeCheckingTests
namespace FSharp.Compiler.GraphChecking

#nowarn "1182"
#nowarn "40"

open System.Collections.Concurrent
open System.Collections.Generic
open System.IO
open Newtonsoft.Json
open System.Linq

/// <summary> Directed Acyclic Graph (DAG) of arbitrary nodes </summary>
type Graph<'Node> = IReadOnlyDictionary<'Node, 'Node[]>
Expand Down Expand Up @@ -36,9 +35,8 @@ module Graph =
|> Seq.except (graph.Keys |> Seq.toArray)
|> fun missing ->
let toAdd = missing |> Seq.map (fun n -> KeyValuePair(n, [||])) |> Seq.toArray

let x = Array.append (graph |> Seq.toArray) toAdd
x |> Dictionary<_, _> |> (fun x -> x :> IReadOnlyDictionary<_, _>)
let x: KeyValuePair<'Node, 'Node[]>[] = Array.append (graph |> Seq.toArray) toAdd
x.ToDictionary((fun (KeyValue (x, _)) -> x), (fun (KeyValue (_, v)) -> v)) :> IReadOnlyDictionary<_, _>

/// Create entries for nodes that don't have any dependencies but are mentioned as dependencies themselves
let fillEmptyNodes<'Node when 'Node: equality> (graph: Graph<'Node>) : Graph<'Node> =
Expand Down Expand Up @@ -85,7 +83,17 @@ module Graph =
let print (graph: Graph<'Node>) : unit =
printCustom graph (fun node -> node.ToString())

let serialiseToJson (path: string) (graph: Graph<'Node>) : unit =
let json = JsonConvert.SerializeObject(graph, Formatting.Indented)
printfn $"Serialising graph as JSON in {path}"
File.WriteAllText(path, json)
let serialiseToJson (path: string) (graph: Graph<string>) : unit =
let escapeName (name: string) =
name.Replace("\\", "\\\\") |> sprintf "\"%s\""

let entries =
graph
|> Seq.map (fun (KeyValue (file, deps)) ->
let deps = deps |> Seq.map escapeName |> String.concat "," |> sprintf "[ %s ]"

$" {escapeName file}: {deps}")
|> String.concat ","

let json = $"{{\n{entries}\n}}"
System.IO.File.WriteAllText(path, json)
Original file line number Diff line number Diff line change
@@ -1,9 +1,9 @@
/// Parallel processing of graph of work items with dependencies
module ParallelTypeCheckingTests.GraphProcessing
module FSharp.Compiler.GraphChecking.GraphProcessing

open System.Threading

/// Information about the node in a graph, describing its relation with other nodes.
/// Information about the node in a graph, describing its relation with other nodes.
type NodeInfo<'Item> =
{
Item: 'Item
Expand All @@ -17,8 +17,7 @@ type IncrementableInt(value: int) =
with
member this.Value = value
// Increment the value in a thread-safe manner and return the new value.
member this.Increment() =
Interlocked.Increment (&value)
member this.Increment() = Interlocked.Increment(&value)

type private GraphNode<'Item, 'Result> =
{
Expand Down Expand Up @@ -101,29 +100,28 @@ let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison>
}

let processedCount = IncrementableInt(0)
let mutable exn : ('Item * System.Exception) option = None
let mutable exn: ('Item * System.Exception) option = None

let incrementProcessedNodesCount () =
if processedCount.Increment() = nodes.Count then
waitHandle.Set() |> ignore
waitHandle.Set()

let rec queueNode node =
Async.Start(
async {
let! res =
async {
processNode node
}
|> Async.Catch
let! res = async { processNode node } |> Async.Catch

match res with
| Choice1Of2 () -> ()
| Choice2Of2 ex ->
exn <- Some (node.Info.Item, ex)
waitHandle.Set() |> ignore
}
,ct)
exn <- Some(node.Info.Item, ex)
waitHandle.Set()
},
ct
)

and processNode (node: GraphNode<'Item, 'Result>) : unit =

let info = node.Info

let singleRes = work getItemPublicNode info
Expand All @@ -141,14 +139,14 @@ let processGraph<'Item, 'Result when 'Item: equality and 'Item: comparison>

unblockedDependants |> Array.iter queueNode
incrementProcessedNodesCount ()

leaves |> Array.iter queueNode

waitHandle.Wait(ct) |> ignore
waitHandle.Wait(ct)

match exn with
| None -> ()
| Some (item, ex) ->
raise (System.Exception($"Encountered exception when processing item '{item}'", ex))
| Some (item, ex) -> raise (System.Exception($"Encountered exception when processing item '{item}'", ex))

nodes.Values
|> Seq.map (fun node ->
Expand Down
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
module ParallelTypeCheckingTests.Parallel
module FSharp.Compiler.GraphChecking.Parallel

open System
open System.Collections.Concurrent
Expand Down
Original file line number Diff line number Diff line change
@@ -1,11 +1,11 @@
module ParallelTypeCheckingTests.TrieMapping
module FSharp.Compiler.GraphChecking.TrieMapping

open System.Collections.Generic
open FSharp.Compiler.Syntax
open Microsoft.FSharp.Collections

let hs f = HashSet(Seq.singleton f)
let emptyHS () = HashSet(0)
let emptyHS () = HashSet(Seq.empty)

let private autoOpenShapes =
set
Expand Down Expand Up @@ -94,6 +94,19 @@ let mergeTrieNodes (defaultChildSize: int) (tries: TrieNode array) =

root

let private mkDictFromKeyValuePairs (items: KeyValuePair<'tkey, 'tvalue> seq) =
let dict = Dictionary(Seq.length items)

for KeyValue (k, v) in items do
dict.Add(k, v)
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Isn't this what dictionary construction provides?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

That is not available in netstandard2.0, I had to change some of the dictionary code because there is no such constructor available.


dict

let private mkSingletonDict key value =
let dict = Dictionary(1)
dict.Add(key, value)
dict

/// Process a top level SynModuleOrNamespace(Sig)
let processSynModuleOrNamespace<'Decl>
(mkTrieForDeclaration: int -> 'Decl -> KeyValuePair<string, TrieNode> option)
Expand Down Expand Up @@ -136,21 +149,16 @@ let processSynModuleOrNamespace<'Decl>
else
TrieNodeInfo.Module(name, idx)

let children = List.choose (mkTrieForDeclaration idx) decls

continuation (
Dictionary<_, _>(
Seq.singleton (
KeyValuePair(
name,
{
Current = current
Children = Dictionary(children)
}
)
)
)
)
let children =
List.choose (mkTrieForDeclaration idx) decls |> mkDictFromKeyValuePairs

mkSingletonDict
name
{
Current = current
Children = children
}
|> continuation
| head :: tail ->
let name = head.idText

Expand All @@ -175,14 +183,13 @@ let processSynModuleOrNamespace<'Decl>

let current = TrieNodeInfo.Namespace(name, files)

Dictionary<_, _>(Seq.singleton (KeyValuePair(name, { Current = current; Children = node })))
|> continuation)
mkSingletonDict name { Current = current; Children = node } |> continuation)
tail

if List.isEmpty name then
// This can happen for a namespace global.
// We collect the child nodes from the decls
List.choose (mkTrieForDeclaration idx) decls |> Dictionary
List.choose (mkTrieForDeclaration idx) decls |> mkDictFromKeyValuePairs
else
visit id name

Expand Down Expand Up @@ -243,14 +250,16 @@ and mkTrieForSynModuleDecl (fileIndex: int) (decl: SynModuleDecl) : KeyValuePair
match decl with
| SynModuleDecl.NestedModule (moduleInfo = SynComponentInfo(longId = [ nestedModuleIdent ]); decls = decls) ->
let name = nestedModuleIdent.idText
let children = List.choose (mkTrieForSynModuleDecl fileIndex) decls

let children =
List.choose (mkTrieForSynModuleDecl fileIndex) decls |> mkDictFromKeyValuePairs

Some(
KeyValuePair(
name,
{
Current = TrieNodeInfo.Module(name, fileIndex)
Children = Dictionary(children)
Children = children
}
)
)
Expand All @@ -260,14 +269,17 @@ and mkTrieForSynModuleSigDecl (fileIndex: int) (decl: SynModuleSigDecl) : KeyVal
match decl with
| SynModuleSigDecl.NestedModule (moduleInfo = SynComponentInfo(longId = [ nestedModuleIdent ]); moduleDecls = decls) ->
let name = nestedModuleIdent.idText
let children = List.choose (mkTrieForSynModuleSigDecl fileIndex) decls

let children =
List.choose (mkTrieForSynModuleSigDecl fileIndex) decls
|> mkDictFromKeyValuePairs

Some(
KeyValuePair(
name,
{
Current = TrieNodeInfo.Module(name, fileIndex)
Children = Dictionary(children)
Children = children
}
)
)
Expand Down
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
/// Parallel processing of graph of work items with dependencies
module ParallelTypeCheckingTests.TypeCheckingGraphProcessing
module FSharp.Compiler.GraphChecking.TypeCheckingGraphProcessing

open ParallelTypeCheckingTests.GraphProcessing
open GraphProcessing
open System.Collections.Generic
open System.Threading

Expand All @@ -11,6 +11,7 @@ open System.Threading
/// <summary>
/// Combine type-checking results of dependencies needed to type-check a 'higher' node in the graph
/// </summary>
/// <param name="emptyState">Initial state</param>
/// <param name="deps">Direct dependencies of a node</param>
/// <param name="transitiveDeps">Transitive dependencies of a node</param>
/// <param name="folder">A way to fold a single result into existing state</param>
Expand Down Expand Up @@ -42,6 +43,7 @@ let private combineResults
let set = HashSet(biggestDependency.Info.TransitiveDeps)
set.Add biggestDependency.Info.Item |> ignore
set

let resultsToAdd =
transitiveDeps
|> Array.filter (fun dep -> itemsPresent.Contains dep.Info.Item = false)
Expand All @@ -68,10 +70,7 @@ let processTypeCheckingGraph<'Item, 'ChosenItem, 'State, 'Result, 'FinalFileResu
(ct: CancellationToken)
: ('ChosenItem * 'FinalFileResult) list * 'State =

let workWrapper
(getProcessedNode: 'Item -> ProcessedNode<'Item, 'State * 'Result>)
(node: NodeInfo<'Item>)
: 'State * 'Result =
let workWrapper (getProcessedNode: 'Item -> ProcessedNode<'Item, 'State * 'Result>) (node: NodeInfo<'Item>) : 'State * 'Result =
let folder x y = folder x y |> snd
let deps = node.Deps |> Array.except [| node.Item |] |> Array.map getProcessedNode

Expand All @@ -91,9 +90,8 @@ let processTypeCheckingGraph<'Item, 'ChosenItem, 'State, 'Result, 'FinalFileResu
results
|> Array.choose (fun (item, res) ->
match finalStateChooser item with
| Some item -> Some (item, res)
| None -> None
)
| Some item -> Some(item, res)
| None -> None)
|> Array.fold
(fun (fileResults, state) (item, (_, itemRes)) ->
let fileResult, state = folder state itemRes
Expand Down
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
namespace ParallelTypeCheckingTests
namespace FSharp.Compiler.GraphChecking

open System.Collections.Generic
open FSharp.Compiler.Syntax
Expand Down
Loading