diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs
index b8ca157ad60..6021bb659ca 100644
--- a/src/Compiler/Driver/CompilerImports.fs
+++ b/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.
diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs
index b011cc1971b..d9a402a57f9 100644
--- a/src/Compiler/Driver/ParseAndCheckInputs.fs
+++ b/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
diff --git a/src/Compiler/FSharp.Compiler.Service.fsproj b/src/Compiler/FSharp.Compiler.Service.fsproj
index cc6f8b6dcaa..604a325f73d 100644
--- a/src/Compiler/FSharp.Compiler.Service.fsproj
+++ b/src/Compiler/FSharp.Compiler.Service.fsproj
@@ -283,6 +283,8 @@
+
+
diff --git a/src/Compiler/TypedTree/TypeTreeSerialization.fs b/src/Compiler/TypedTree/TypeTreeSerialization.fs
new file mode 100644
index 00000000000..d3ce682af23
--- /dev/null
+++ b/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)
diff --git a/src/Compiler/TypedTree/TypeTreeSerialization.fsi b/src/Compiler/TypedTree/TypeTreeSerialization.fsi
new file mode 100644
index 00000000000..22e9c417b54
--- /dev/null
+++ b/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
diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs
index 7021a523e88..44dd905dd91 100644
--- a/src/Compiler/TypedTree/TypedTreeOps.fs
+++ b/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)
diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi
index c6cf1c303a8..3d08c973e1c 100755
--- a/src/Compiler/TypedTree/TypedTreeOps.fsi
+++ b/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
diff --git a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/CompilationTests.fs b/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/CompilationTests.fs
index c1df009ffff..dc5f30df911 100644
--- a/tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/CompilationTests.fs
+++ b/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