From 267db84a0e42f2284d2c225280b6c18e2228e580 Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Tue, 3 Nov 2020 21:47:12 +0300 Subject: [PATCH 1/6] Don't add "opens" for parens namespaces to tc environments --- src/fsharp/CheckDeclarations.fs | 10 +++++----- src/fsharp/CheckExpressions.fs | 15 ++++++++++----- src/fsharp/CheckExpressions.fsi | 4 ++-- src/fsharp/TypedTreeOps.fs | 15 +++++---------- src/fsharp/TypedTreeOps.fsi | 3 +-- 5 files changed, 23 insertions(+), 24 deletions(-) diff --git a/src/fsharp/CheckDeclarations.fs b/src/fsharp/CheckDeclarations.fs index ba9974374d7..dfc93ec46ea 100644 --- a/src/fsharp/CheckDeclarations.fs +++ b/src/fsharp/CheckDeclarations.fs @@ -2175,7 +2175,7 @@ module MutRecBindingChecking = /// Compute the active environments within each nested module. let TcMutRecDefns_ComputeEnvs getTyconOpt getVals (cenv: cenv) report scopem m envInitial mutRecShape = (envInitial, mutRecShape) ||> MutRecShapes.computeEnvs - (fun envAbove (MutRecDefnsPhase2DataForModule (mtypeAcc, mspec)) -> MakeInnerEnvWithAcc envAbove mspec.Id mtypeAcc mspec.ModuleOrNamespaceType.ModuleOrNamespaceKind) + (fun envAbove (MutRecDefnsPhase2DataForModule (mtypeAcc, mspec)) -> MakeInnerEnvWithAcc true envAbove mspec.Id mtypeAcc mspec.ModuleOrNamespaceType.ModuleOrNamespaceKind) (fun envAbove decls -> // Collect the type definitions, exception definitions, modules and "open" declarations @@ -3202,7 +3202,7 @@ module EstablishTypeDefinitionCores = CheckForDuplicateConcreteType envInitial id.idText im CheckNamespaceModuleOrTypeName cenv.g id - let envForDecls, mtypeAcc = MakeInnerEnv envInitial id modKind + let envForDecls, mtypeAcc = MakeInnerEnv true envInitial id modKind let mty = Construct.NewEmptyModuleOrNamespaceType modKind let doc = xml.ToXmlDoc(true, Some []) let mspec = Construct.NewModuleOrNamespace (Some envInitial.eCompPath) vis id doc modAttrs (MaybeLazy.Strict mty) @@ -4341,7 +4341,7 @@ module EstablishTypeDefinitionCores = (envInitial, withEntities) ||> MutRecShapes.computeEnvs (fun envAbove (MutRecDefnsPhase2DataForModule (mtypeAcc, mspec)) -> PublishModuleDefn cenv envAbove mspec - MakeInnerEnvWithAcc envAbove mspec.Id mtypeAcc mspec.ModuleOrNamespaceType.ModuleOrNamespaceKind) + MakeInnerEnvWithAcc true envAbove mspec.Id mtypeAcc mspec.ModuleOrNamespaceType.ModuleOrNamespaceKind) (fun envAbove _ -> envAbove) // Updates the types of the modules to contain the contents so far, which now includes the nested modules and types @@ -5212,7 +5212,7 @@ and TcModuleOrNamespaceSignatureElementsNonMutRec cenv parent env (id, modKind, let endm = m.EndRange // use end of range for errors // Create the module type that will hold the results of type checking.... - let envForModule, mtypeAcc = MakeInnerEnv env id modKind + let envForModule, mtypeAcc = MakeInnerEnv true env id modKind // Now typecheck the signature, using mutation to fill in the submodule description. let! envAtEnd = TcSignatureElements cenv parent endm envForModule xml None defs @@ -5350,7 +5350,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv: cenv) parent typeNames scopem CheckNamespaceModuleOrTypeName cenv.g id - let envForModule, mtypeAcc = MakeInnerEnv env id modKind + let envForModule, mtypeAcc = MakeInnerEnv true env id modKind // Create the new module specification to hold the accumulated results of the type of the module // Also record this in the environment as the accumulator diff --git a/src/fsharp/CheckExpressions.fs b/src/fsharp/CheckExpressions.fs index e605db2c654..031a9e6f758 100644 --- a/src/fsharp/CheckExpressions.fs +++ b/src/fsharp/CheckExpressions.fs @@ -449,7 +449,7 @@ let UnifyTypes cenv (env: TcEnv) m actualTy expectedTy = ConstraintSolver.AddCxTypeEqualsType env.eContextInfo env.DisplayEnv cenv.css m (tryNormalizeMeasureInType cenv.g actualTy) (tryNormalizeMeasureInType cenv.g expectedTy) /// Make an environment suitable for a module or namespace. Does not create a new accumulator but uses one we already have/ -let MakeInnerEnvWithAcc env nm mtypeAcc modKind = +let MakeInnerEnvWithAcc addOpenToEnv env nm mtypeAcc modKind = let path = env.ePath @ [nm] let cpath = env.eCompPath.NestedCompPath nm.idText modKind { env with @@ -457,14 +457,18 @@ let MakeInnerEnvWithAcc env nm mtypeAcc modKind = eCompPath = cpath eAccessPath = cpath eAccessRights = ComputeAccessRights cpath env.eInternalsVisibleCompPaths env.eFamilyType // update this computed field - eNameResEnv = { env.NameEnv with eDisplayEnv = env.DisplayEnv.AddOpenPath (pathOfLid path) } + eNameResEnv = + if addOpenToEnv then + { env.NameEnv with eDisplayEnv = env.DisplayEnv.AddOpenPath (pathOfLid path) } + else + env.NameEnv eModuleOrNamespaceTypeAccumulator = mtypeAcc } /// Make an environment suitable for a module or namespace, creating a new accumulator. -let MakeInnerEnv env nm modKind = +let MakeInnerEnv addOpenToEnv env nm modKind = // Note: here we allocate a new module type accumulator let mtypeAcc = ref (Construct.NewEmptyModuleOrNamespaceType modKind) - MakeInnerEnvWithAcc env nm mtypeAcc modKind, mtypeAcc + MakeInnerEnvWithAcc addOpenToEnv env nm mtypeAcc modKind, mtypeAcc /// Make an environment suitable for processing inside a type definition let MakeInnerEnvForTyconRef env tcref isExtrinsicExtension = @@ -502,7 +506,8 @@ let LocateEnv ccu env enclosingNamespacePath = eAccessPath = cpath // update this computed field eAccessRights = ComputeAccessRights cpath env.eInternalsVisibleCompPaths env.eFamilyType } - let env = List.fold (fun env id -> MakeInnerEnv env id Namespace |> fst) env enclosingNamespacePath + let env = List.fold (fun env id -> MakeInnerEnv false env id Namespace |> fst) env enclosingNamespacePath + let env = { env with eNameResEnv = { env.NameEnv with eDisplayEnv = env.DisplayEnv.AddOpenPath (pathOfLid env.ePath) } } env diff --git a/src/fsharp/CheckExpressions.fsi b/src/fsharp/CheckExpressions.fsi index 39d076cf3aa..1e07c03faf2 100644 --- a/src/fsharp/CheckExpressions.fsi +++ b/src/fsharp/CheckExpressions.fsi @@ -610,11 +610,11 @@ val MakeInnerEnvForTyconRef: env: TcEnv -> tcref: TyconRef -> isExtrinsicExtensi /// Return a new environment suitable for processing declarations in the interior of a module definition /// including creating an accumulator for the module type. -val MakeInnerEnv: env: TcEnv -> nm: Ident -> modKind: ModuleOrNamespaceKind -> TcEnv * ModuleOrNamespaceType ref +val MakeInnerEnv: addOpenToEnv: bool -> env: TcEnv -> nm: Ident -> modKind: ModuleOrNamespaceKind -> TcEnv * ModuleOrNamespaceType ref /// Return a new environment suitable for processing declarations in the interior of a module definition /// given that the accumulator for the module type already exisits. -val MakeInnerEnvWithAcc: env: TcEnv -> nm: Ident -> mtypeAcc: ModuleOrNamespaceType ref -> modKind: ModuleOrNamespaceKind -> TcEnv +val MakeInnerEnvWithAcc: addOpenToEnv: bool -> env: TcEnv -> nm: Ident -> mtypeAcc: ModuleOrNamespaceType ref -> modKind: ModuleOrNamespaceKind -> TcEnv /// Produce a post-generalization type scheme for a simple type where no type inference generalization /// is appplied. diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 8ce4839b3da..71dcf086da1 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -2726,8 +2726,7 @@ module SimplifyTypes = [] type DisplayEnv = { includeStaticParametersInTypeNames: bool - openTopPathsSorted: Lazy - openTopPathsRaw: string list list + openTopPaths: string list list shortTypeNames: bool suppressNestedTypes: bool maxMembers: int option @@ -2750,15 +2749,11 @@ type DisplayEnv = generatedValueLayout : (Val -> layout option) } member x.SetOpenPaths paths = - { x with - openTopPathsSorted = (lazy (paths |> List.sortWith (fun p1 p2 -> -(compare p1 p2)))) - openTopPathsRaw = paths - } + { x with openTopPaths = paths } static member Empty tcGlobals = { includeStaticParametersInTypeNames = false - openTopPathsRaw = [] - openTopPathsSorted = notlazy [] + openTopPaths = [] shortTypeNames = false suppressNestedTypes = false maxMembers = None @@ -2782,7 +2777,7 @@ type DisplayEnv = member denv.AddOpenPath path = - denv.SetOpenPaths (path :: denv.openTopPathsRaw) + denv.SetOpenPaths (path :: denv.openTopPaths) member denv.AddOpenModuleOrNamespace (modref: ModuleOrNamespaceRef) = denv.AddOpenPath (fullCompPathOfModuleOrNamespace modref.Deref).DemangledPath @@ -2972,7 +2967,7 @@ let trimPathByDisplayEnv denv path = else Some("") else None - match List.tryPick findOpenedNamespace (denv.openTopPathsSorted.Force()) with + match List.tryPick findOpenedNamespace denv.openTopPaths with | Some s -> s | None -> if isNil path then "" else textOfPath path + "." diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index c209ace4ec6..04aaa941a18 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -960,8 +960,7 @@ module PrettyTypes = [] type DisplayEnv = { includeStaticParametersInTypeNames : bool - openTopPathsSorted: Lazy - openTopPathsRaw: string list list + openTopPaths: string list list shortTypeNames: bool suppressNestedTypes: bool maxMembers : int option From ef2e7f506fffe12b9e3bce68b02c84a3e0539e65 Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Tue, 3 Nov 2020 23:14:14 +0300 Subject: [PATCH 2/6] Revert sorted opens change --- src/fsharp/TypedTreeOps.fs | 15 ++++++++++----- src/fsharp/TypedTreeOps.fsi | 3 ++- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index 71dcf086da1..8ce4839b3da 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -2726,7 +2726,8 @@ module SimplifyTypes = [] type DisplayEnv = { includeStaticParametersInTypeNames: bool - openTopPaths: string list list + openTopPathsSorted: Lazy + openTopPathsRaw: string list list shortTypeNames: bool suppressNestedTypes: bool maxMembers: int option @@ -2749,11 +2750,15 @@ type DisplayEnv = generatedValueLayout : (Val -> layout option) } member x.SetOpenPaths paths = - { x with openTopPaths = paths } + { x with + openTopPathsSorted = (lazy (paths |> List.sortWith (fun p1 p2 -> -(compare p1 p2)))) + openTopPathsRaw = paths + } static member Empty tcGlobals = { includeStaticParametersInTypeNames = false - openTopPaths = [] + openTopPathsRaw = [] + openTopPathsSorted = notlazy [] shortTypeNames = false suppressNestedTypes = false maxMembers = None @@ -2777,7 +2782,7 @@ type DisplayEnv = member denv.AddOpenPath path = - denv.SetOpenPaths (path :: denv.openTopPaths) + denv.SetOpenPaths (path :: denv.openTopPathsRaw) member denv.AddOpenModuleOrNamespace (modref: ModuleOrNamespaceRef) = denv.AddOpenPath (fullCompPathOfModuleOrNamespace modref.Deref).DemangledPath @@ -2967,7 +2972,7 @@ let trimPathByDisplayEnv denv path = else Some("") else None - match List.tryPick findOpenedNamespace denv.openTopPaths with + match List.tryPick findOpenedNamespace (denv.openTopPathsSorted.Force()) with | Some s -> s | None -> if isNil path then "" else textOfPath path + "." diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index 04aaa941a18..c209ace4ec6 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -960,7 +960,8 @@ module PrettyTypes = [] type DisplayEnv = { includeStaticParametersInTypeNames : bool - openTopPaths: string list list + openTopPathsSorted: Lazy + openTopPathsRaw: string list list shortTypeNames: bool suppressNestedTypes: bool maxMembers : int option From f419eede563a88eb770adb96dad16de6bd522e00 Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Wed, 4 Nov 2020 00:58:39 +0300 Subject: [PATCH 3/6] Better parameter name --- src/fsharp/CheckExpressions.fs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/fsharp/CheckExpressions.fs b/src/fsharp/CheckExpressions.fs index 031a9e6f758..2ab22e7f411 100644 --- a/src/fsharp/CheckExpressions.fs +++ b/src/fsharp/CheckExpressions.fs @@ -449,7 +449,7 @@ let UnifyTypes cenv (env: TcEnv) m actualTy expectedTy = ConstraintSolver.AddCxTypeEqualsType env.eContextInfo env.DisplayEnv cenv.css m (tryNormalizeMeasureInType cenv.g actualTy) (tryNormalizeMeasureInType cenv.g expectedTy) /// Make an environment suitable for a module or namespace. Does not create a new accumulator but uses one we already have/ -let MakeInnerEnvWithAcc addOpenToEnv env nm mtypeAcc modKind = +let MakeInnerEnvWithAcc addOpenToNameEnv env nm mtypeAcc modKind = let path = env.ePath @ [nm] let cpath = env.eCompPath.NestedCompPath nm.idText modKind { env with @@ -458,17 +458,17 @@ let MakeInnerEnvWithAcc addOpenToEnv env nm mtypeAcc modKind = eAccessPath = cpath eAccessRights = ComputeAccessRights cpath env.eInternalsVisibleCompPaths env.eFamilyType // update this computed field eNameResEnv = - if addOpenToEnv then + if addOpenToNameEnv then { env.NameEnv with eDisplayEnv = env.DisplayEnv.AddOpenPath (pathOfLid path) } else env.NameEnv eModuleOrNamespaceTypeAccumulator = mtypeAcc } /// Make an environment suitable for a module or namespace, creating a new accumulator. -let MakeInnerEnv addOpenToEnv env nm modKind = +let MakeInnerEnv addOpenToNameEnv env nm modKind = // Note: here we allocate a new module type accumulator let mtypeAcc = ref (Construct.NewEmptyModuleOrNamespaceType modKind) - MakeInnerEnvWithAcc addOpenToEnv env nm mtypeAcc modKind, mtypeAcc + MakeInnerEnvWithAcc addOpenToNameEnv env nm mtypeAcc modKind, mtypeAcc /// Make an environment suitable for processing inside a type definition let MakeInnerEnvForTyconRef env tcref isExtrinsicExtension = From 74106b1c49aa3fb7c696e4a3b5e9052dd840b32e Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Wed, 4 Nov 2020 01:48:59 +0300 Subject: [PATCH 4/6] Add test --- tests/service/Common.fs | 13 +++++++++++++ tests/service/Symbols.fs | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 45 insertions(+) diff --git a/tests/service/Common.fs b/tests/service/Common.fs index 418950f403b..080049d5f92 100644 --- a/tests/service/Common.fs +++ b/tests/service/Common.fs @@ -395,6 +395,19 @@ let assertHasSymbolUsages (names: string list) (results: FSharpCheckFileResults) for name in names do Assert.That(Set.contains name symbolNames, name) + +let findSymbolUseByName (name: string) (results: FSharpCheckFileResults) = + getSymbolUses results + |> Array.find (fun symbolUse -> + match getSymbolName symbolUse.Symbol with + | Some symbolName -> symbolName = name + | _ -> false) + +let findSymbolByName (name: string) (results: FSharpCheckFileResults) = + let symbolUse = findSymbolUseByName name results + symbolUse.Symbol + + let getRangeCoords (r: range) = (r.StartLine, r.StartColumn), (r.EndLine, r.EndColumn) diff --git a/tests/service/Symbols.fs b/tests/service/Symbols.fs index 11f5984b5d6..23a53eb4f40 100644 --- a/tests/service/Symbols.fs +++ b/tests/service/Symbols.fs @@ -122,3 +122,35 @@ let x = 123 |> Option.orElseWith (fun _ -> failwith "Could not get symbol") |> Option.map (fun su -> su.Symbol :?> FSharpMemberOrFunctionOrValue) |> Option.iter (fun symbol -> symbol.Attributes.Count |> shouldEqual 1) + +module Types = + [] + let ``FSharpType.Print parent namespace qualifiers`` () = + let _, checkResults = getParseAndCheckResults """ +namespace Ns1.Ns2 +type T() = class end +type A = T + +namespace Ns1.Ns3 +type B = Ns1.Ns2.T + +namespace Ns1.Ns4 +open Ns1.Ns2 +type C = Ns1.Ns2.T + +namespace Ns1.Ns5 +open Ns1 +type D = Ns1.Ns2.T +""" + [| "A", "T" + "B", "Ns1.Ns2.T" + "C", "T" + "D", "Ns2.T" |] + |> Array.iter (fun (symbolName, expectedPrintedType) -> + let symbolUse = findSymbolUseByName symbolName checkResults + match symbolUse.Symbol with + | :? FSharpEntity as entity -> + entity.AbbreviatedType.Format(symbolUse.DisplayContext) + |> should equal expectedPrintedType + + | _ -> failwithf "Couldn't get entity: %s" symbolName) From 13a01a82217ca6e221ec9a647cf5ca8f2ce8d9bd Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Wed, 4 Nov 2020 01:53:21 +0300 Subject: [PATCH 5/6] Update parameter name in signature --- src/fsharp/CheckExpressions.fsi | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fsharp/CheckExpressions.fsi b/src/fsharp/CheckExpressions.fsi index 1e07c03faf2..e208ee42a81 100644 --- a/src/fsharp/CheckExpressions.fsi +++ b/src/fsharp/CheckExpressions.fsi @@ -610,11 +610,11 @@ val MakeInnerEnvForTyconRef: env: TcEnv -> tcref: TyconRef -> isExtrinsicExtensi /// Return a new environment suitable for processing declarations in the interior of a module definition /// including creating an accumulator for the module type. -val MakeInnerEnv: addOpenToEnv: bool -> env: TcEnv -> nm: Ident -> modKind: ModuleOrNamespaceKind -> TcEnv * ModuleOrNamespaceType ref +val MakeInnerEnv: addOpenToNameEnv: bool -> env: TcEnv -> nm: Ident -> modKind: ModuleOrNamespaceKind -> TcEnv * ModuleOrNamespaceType ref /// Return a new environment suitable for processing declarations in the interior of a module definition /// given that the accumulator for the module type already exisits. -val MakeInnerEnvWithAcc: addOpenToEnv: bool -> env: TcEnv -> nm: Ident -> mtypeAcc: ModuleOrNamespaceType ref -> modKind: ModuleOrNamespaceKind -> TcEnv +val MakeInnerEnvWithAcc: addOpenToNameEnv: bool -> env: TcEnv -> nm: Ident -> mtypeAcc: ModuleOrNamespaceType ref -> modKind: ModuleOrNamespaceKind -> TcEnv /// Produce a post-generalization type scheme for a simple type where no type inference generalization /// is appplied. From 736fcd8e6ded4703f99d4cee22d756b311bdfceb Mon Sep 17 00:00:00 2001 From: Eugene Auduchinok Date: Wed, 4 Nov 2020 02:03:37 +0300 Subject: [PATCH 6/6] Add another test case --- tests/service/Symbols.fs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/tests/service/Symbols.fs b/tests/service/Symbols.fs index 23a53eb4f40..4ecd5b372c0 100644 --- a/tests/service/Symbols.fs +++ b/tests/service/Symbols.fs @@ -141,11 +141,15 @@ type C = Ns1.Ns2.T namespace Ns1.Ns5 open Ns1 type D = Ns1.Ns2.T + +namespace Ns1.Ns2.Ns6 +type E = Ns1.Ns2.T """ [| "A", "T" "B", "Ns1.Ns2.T" "C", "T" - "D", "Ns2.T" |] + "D", "Ns2.T" + "E", "Ns1.Ns2.T" |] |> Array.iter (fun (symbolName, expectedPrintedType) -> let symbolUse = findSymbolUseByName symbolName checkResults match symbolUse.Symbol with