Workaround typar pretty naming for graph type-checking.

src/Compiler/Driver/CompilerImports.fs

@@ -143,7 +143,7 @@ let WriteSignatureData (tcConfig: TcConfig, tcGlobals, exportRemapping, ccu: Ccu
         |> Option.iter (fun outputFile ->
             let outputFile = FileSystem.GetFullPathShim(outputFile)
             let signatureDataFile = FileSystem.ChangeExtensionShim(outputFile, ".signature-data.json")
-            serializeEntity signatureDataFile mspec)
+            TypeTreeSerialization.serializeEntity signatureDataFile mspec)
 
     // For historical reasons, we use a different resource name for FSharp.Core, so older F# compilers
     // don't complain when they see the resource.

src/Compiler/Driver/ParseAndCheckInputs.fs

@@ -1779,11 +1779,51 @@ let CheckMultipleInputsUsingGraphMode
 
         partialResults, tcState)
 
+/// The Typars of a Val can be determined by the call site.
+/// As the type-checking can now happen in parallel, the naming is no longer deterministic.
+/// Overall this only seems to affect the pickled signature data later on.
+/// But in order to regain deterministic names, we re-do the pretty naming for all typars of Vals.
+module UpdatePrettyNames =
+    let rec updateEntity (entity: Entity) =
+        for e in entity.ModuleOrNamespaceType.AllEntities do
+            updateEntity e
+
+        for v in entity.ModuleOrNamespaceType.AllValsAndMembers do
+            updateVal v
+
+    and private updateVal (v: Val) =
+        if not (List.isEmpty v.Typars) then
+            // Reset typar name to ?
+            for typar in v.Typars do
+                if typar.IsCompilerGenerated && typar.ILName.IsNone then
+                    typar.typar_id <- Ident(unassignedTyparName, typar.typar_id.idRange)
+
+            let nms = PrettyTypes.PrettyTyparNames (fun _ -> true) List.empty v.Typars
+
+            (v.Typars, nms)
+            ||> List.iter2 (fun tp nm -> tp.typar_id <- ident (nm, tp.Range))
+
+    and updateModuleOrNamespaceContent (contents: ModuleOrNamespaceContents) =
+        match contents with
+        | ModuleOrNamespaceContents.TMDefs defs ->
+            for def in defs do
+                updateModuleOrNamespaceContent def
+        | ModuleOrNamespaceContents.TMDefDo _
+        | ModuleOrNamespaceContents.TMDefOpens _ -> ()
+        | ModuleOrNamespaceContents.TMDefLet (binding, _) -> updateBinding binding
+        | ModuleOrNamespaceContents.TMDefRec (bindings = bindings) ->
+            for binding in bindings do
+                match binding with
+                | ModuleOrNamespaceBinding.Binding binding -> updateBinding binding
+                | ModuleOrNamespaceBinding.Module (_, moduleOrNamespaceContents) -> updateModuleOrNamespaceContent moduleOrNamespaceContents
+
+    and private updateBinding (binding: Binding) = updateVal binding.Var
+
 let CheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, eagerFormat, inputs) =
     // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions
     let results, tcState =
         match tcConfig.typeCheckingConfig.Mode with
-        | TypeCheckingMode.Graph when (not tcConfig.isInteractive && not tcConfig.deterministic) ->
+        | TypeCheckingMode.Graph when (not tcConfig.isInteractive) ->
             CheckMultipleInputsUsingGraphMode(
                 ctok,
                 checkForErrors,
@@ -1803,5 +1843,10 @@ let CheckClosedInputSet (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tc
     let tcState, declaredImpls, ccuContents =
         CheckClosedInputSetFinish(implFiles, tcState)
 
+    for declImpl in declaredImpls do
+        UpdatePrettyNames.updateModuleOrNamespaceContent declImpl.Contents
+
+    UpdatePrettyNames.updateEntity ccuContents
+
     tcState.Ccu.Deref.Contents <- ccuContents
     tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile

src/Compiler/FSharp.Compiler.Service.fsproj

@@ -283,6 +283,8 @@
     <Compile Include="TypedTree\TypedTreeOps.fs" />
     <Compile Include="TypedTree\TypedTreePickle.fsi" />
     <Compile Include="TypedTree\TypedTreePickle.fs" />
+    <Compile Include="TypedTree\TypeTreeSerialization.fsi" />
+    <Compile Include="TypedTree\TypeTreeSerialization.fs" />
     <Compile Include="Checking\import.fsi" />
     <Compile Include="Checking\import.fs" />
     <Compile Include="Checking\TypeHierarchy.fsi" />

src/Compiler/TypedTree/TypeTreeSerialization.fs

@@ -0,0 +1,161 @@
+module FSharp.Compiler.TypeTreeSerialization
+
+open System.CodeDom.Compiler
+open FSharp.Compiler.Text
+open Internal.Utilities.Library
+
+open FSharp.Compiler.IO
+open FSharp.Compiler.TypedTree
+
+type TypedTreeNode =
+    {
+        Kind: string
+        Name: string
+        Children: TypedTreeNode list
+        Flags: int64 option
+        Range: range option
+        CompilationPath: CompilationPath option
+    }
+
+let rec visitEntity (entity: Entity) : TypedTreeNode =
+    let kind =
+        if entity.IsModule then "module"
+        elif entity.IsNamespace then "namespace"
+        elif entity.IsUnionTycon then "union"
+        elif entity.IsRecordTycon then "record"
+        elif entity.IsFSharpClassTycon then "class"
+        elif entity.IsErased then "erased"
+        elif entity.IsEnumTycon then "enum"
+        elif entity.IsTypeAbbrev then "abbreviation"
+        elif entity.IsFSharpObjectModelTycon then "objectModel"
+        elif entity.IsFSharpException then "exception"
+        elif entity.IsFSharpDelegateTycon then "delegate"
+        elif entity.IsFSharpInterfaceTycon then "interface"
+        else "other"
+
+    let children =
+        seq {
+            if entity.IsModuleOrNamespace then
+                yield! Seq.map visitEntity entity.ModuleOrNamespaceType.AllEntities
+
+            yield! Seq.map visitVal entity.ModuleOrNamespaceType.AllValsAndMembers
+            yield! visitAttributes entity.Attribs
+        }
+
+    {
+        Kind = kind
+        Name = entity.CompiledName
+        Children = Seq.toList children
+        Flags = Some entity.entity_flags.PickledBits
+        Range = Some entity.Range
+        CompilationPath = Some entity.CompilationPath
+    }
+
+and visitVal (v: Val) : TypedTreeNode =
+    let children =
+        seq {
+            yield! visitAttributes v.Attribs
+
+            match v.ValReprInfo with
+            | None -> ()
+            | Some (ValReprInfo (_, args, result)) ->
+                yield! args |> Seq.collect id |> Seq.map visitArgReprInfo
+                yield visitArgReprInfo result
+
+            yield!
+                v.Typars
+                |> Seq.map (fun typar ->
+                    {
+                        Name = typar.Name
+                        Kind = "typar"
+                        Children = []
+                        Flags = Some typar.typar_flags.PickledBits
+                        Range = Some typar.Range
+                        CompilationPath = None
+                    })
+        }
+
+    {
+        Name = v.CompiledName None
+        Kind = "val"
+        Children = Seq.toList children
+        Flags = Some v.val_flags.PickledBits
+        Range = Some v.Range
+        CompilationPath = None
+    }
+
+and visitAttribute (a: Attrib) : TypedTreeNode =
+    {
+        Kind = "attribute"
+        Name = a.TyconRef.CompiledName
+        Children = List.empty
+        Flags = None
+        Range = Some a.Range
+        // I don't think the tycon ComplicationPath is relevant here.
+        CompilationPath = None
+    }
+
+and visitAttributes (attribs: Attribs) : TypedTreeNode seq = List.map visitAttribute attribs
+
+and visitArgReprInfo (argReprInfo: ArgReprInfo) =
+    {
+        Name = argReprInfo.Name |> Option.map (fun i -> i.idText) |> Option.defaultValue ""
+        Kind = "ArgInfo"
+        Children = []
+        Flags = None
+        Range = None
+        CompilationPath = None
+    }
+
+let write (writer: IndentedTextWriter) key value =
+    writer.WriteLine($"\"%s{key}\": \"{value}\",")
+
+let rec serializeNode (writer: IndentedTextWriter) (addTrailingComma: bool) (node: TypedTreeNode) =
+    writer.WriteLine("{")
+    // Add indent after opening {
+    writer.Indent <- writer.Indent + 1
+
+    write writer "name" node.Name
+    write writer "kind" node.Kind
+
+    node.Flags |> Option.iter (write writer "flags")
+    node.Range |> Option.iter (write writer "range")
+
+    node.CompilationPath
+    |> Option.iter (fun cp -> cp.MangledPath |> String.concat "," |> write writer "compilationPath")
+
+    if node.Children.IsEmpty then
+        writer.WriteLine("\"children\": []")
+    else
+        writer.WriteLine("\"children\": [")
+
+        // Add indent after opening [
+        writer.Indent <- writer.Indent + 1
+
+        node.Children
+        |> List.iteri (fun idx -> serializeNode writer (idx + 1 < node.Children.Length))
+
+        // Remove indent before closing ]
+        writer.Indent <- writer.Indent - 1
+        writer.WriteLine("]")
+
+    // Remove indent before closing }
+    writer.Indent <- writer.Indent - 1
+
+    if addTrailingComma then
+        writer.WriteLine("},")
+    else
+        writer.WriteLine("}")
+
+let rec serializeEntity path (entity: Entity) =
+    let root = visitEntity entity
+    use sw = new System.IO.StringWriter()
+    use writer = new IndentedTextWriter(sw)
+    serializeNode writer false root
+    writer.Flush()
+    let json = sw.ToString()
+
+    use out =
+        FileSystem.OpenFileForWriteShim(path, fileMode = System.IO.FileMode.Create)
+
+    out.WriteAllText(json)

src/Compiler/TypedTree/TypeTreeSerialization.fsi

@@ -0,0 +1,8 @@
+/// Helper code to serialize the typed tree to json
+/// This code is invoked via the `--test:DumpSignatureData` flag.
+module internal FSharp.Compiler.TypeTreeSerialization
+
+open FSharp.Compiler.TypedTree
+
+/// Serialize an entity to a very basic json structure.
+val serializeEntity: path: string -> entity: Entity -> unit

src/Compiler/TypedTree/TypedTreeOps.fs

@@ -10497,106 +10497,3 @@ let tryAddExtensionAttributeIfNotAlreadyPresent
         match tryFindExtensionAttributeIn tryFindExtensionAttribute with
         | None -> entity
         | Some extensionAttrib -> { entity with entity_attribs = extensionAttrib :: entity.Attribs }
-
-type TypedTreeNode =
-    {
-        Kind: string
-        Name: string
-        Children: TypedTreeNode list
-    }
-
-let rec visitEntity (entity: Entity) : TypedTreeNode =
-    let kind =
-        if entity.IsModule then
-            "module"
-        elif entity.IsNamespace then
-            "namespace"
-        else
-            "other"
-
-    let children =
-        if not entity.IsModuleOrNamespace then
-            Seq.empty
-        else
-            seq {
-                yield! Seq.map visitEntity entity.ModuleOrNamespaceType.AllEntities
-                yield! Seq.map visitVal entity.ModuleOrNamespaceType.AllValsAndMembers
-            }
-
-    {
-        Kind = kind
-        Name = entity.CompiledName
-        Children = Seq.toList children
-    }
-
-and visitVal (v: Val) : TypedTreeNode =
-    let children =
-        seq {
-            match v.ValReprInfo with
-            | None -> ()
-            | Some reprInfo ->
-                yield!
-                    reprInfo.ArgInfos
-                    |> Seq.collect (fun argInfos ->
-                        argInfos
-                        |> Seq.map (fun argInfo -> {
-                            Name = argInfo.Name |> Option.map (fun i -> i.idText) |> Option.defaultValue ""
-                            Kind = "ArgInfo"
-                            Children = []
-                        })
-                    )
-
-            yield!
-                v.Typars
-                |> Seq.map (fun typar -> {
-                    Name = typar.Name
-                    Kind = "Typar"
-                    Children = []
-                })
-        }
-
-    {
-        Name = v.CompiledName None
-        Kind = "val"
-        Children = Seq.toList children
-    }
-
-let rec serializeNode (writer: IndentedTextWriter) (addTrailingComma:bool) (node: TypedTreeNode) =
-    writer.WriteLine("{")
-    // Add indent after opening {
-    writer.Indent <- writer.Indent + 1
-
-    writer.WriteLine($"\"name\": \"{node.Name}\",")
-    writer.WriteLine($"\"kind\": \"{node.Kind}\",")
-
-    if node.Children.IsEmpty then
-        writer.WriteLine("\"children\": []")
-    else
-        writer.WriteLine("\"children\": [")
-
-        // Add indent after opening [
-        writer.Indent <- writer.Indent + 1
-
-        node.Children
-        |> List.iteri (fun idx -> serializeNode writer (idx + 1 < node.Children.Length))
-
-        // Remove indent before closing ]
-        writer.Indent <- writer.Indent - 1
-        writer.WriteLine("]")
-
-    // Remove indent before closing }
-    writer.Indent <- writer.Indent - 1
-    if addTrailingComma then
-        writer.WriteLine("},")
-    else
-        writer.WriteLine("}")
-
-let rec serializeEntity path (entity: Entity) =
-    let root = visitEntity entity
-    use sw = new System.IO.StringWriter()
-    use writer = new IndentedTextWriter(sw)
-    serializeNode writer false root
-    writer.Flush()
-    let json = sw.ToString()
-    use out = FileSystem.OpenFileForWriteShim(path, fileMode = System.IO.FileMode.Create)
-    out.WriteAllText(json)

src/Compiler/TypedTree/TypedTreeOps.fsi

@@ -979,7 +979,7 @@ module PrettyTypes =
 
     val NewPrettyTypars: TyparInstantiation -> Typars -> string list -> Typars * TyparInstantiation
 
-    val PrettyTyparNames: (Typar -> bool) -> string list -> Typars -> string list
+    val PrettyTyparNames: pred: (Typar -> bool) -> alreadyInUse: string list -> tps: Typars -> string list
 
     val PrettifyType: TcGlobals -> TType -> TType * TyparConstraintsWithTypars
 
@@ -2695,6 +2695,3 @@ val (|EmptyModuleOrNamespaces|_|):
 /// Add an System.Runtime.CompilerServices.ExtensionAttribute to the Entity if found via predicate and not already present.
 val tryAddExtensionAttributeIfNotAlreadyPresent:
     tryFindExtensionAttributeIn: ((Attrib list -> Attrib option) -> Attrib option) -> entity: Entity -> Entity
-
-/// Serialize an entity to a very basic json structure.
-val serializeEntity: path: string -> entity: Entity -> unit

tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/CompilationTests.fs

@@ -13,7 +13,7 @@ type Method =
 let methodOptions (method: Method) =
     match method with
     | Method.Sequential -> []
-    | Method.Graph -> [ "--test:GraphBasedChecking"; "--test:DumpCheckingGraph"; "--deterministic-" ]
+    | Method.Graph -> [ "--test:GraphBasedChecking"; "--test:DumpCheckingGraph" ]
 
 let withMethod (method: Method) (cu: CompilationUnit) : CompilationUnit =
     match cu with