From b3b02b96877fae572bf0532b77cfb93857a84020 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sat, 14 Jan 2017 10:15:37 +0300 Subject: [PATCH 01/23] remove unnecessary filtering and deduplication --- src/fsharp/vs/service.fs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index 2094eba76a5..70c0980797a 100644 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -1120,7 +1120,10 @@ type TypeCheckInfo NameResolution.GetVisibleNamespacesAndModulesAtPoint ncenv nenv m ad member x.IsRelativeNameResolvable(cursorPos: pos, plid: string list, item: Item) : bool = - let items, _, _ = GetEnvironmentLookupResolutions(cursorPos, plid, TypeNameResolutionFlag.ResolveTypeNamesToTypeRefs, true) + /// Find items in the best naming environment. + let (nenv, ad), m = GetBestEnvForPos cursorPos + let items = NameResolution.ResolvePartialLongIdent ncenv nenv (ConstraintSolver.IsApplicableMethApprox g amap m) m ad plid true + items |> List.exists (ItemsAreEffectivelyEqual g item) /// Get the auto-complete items at a location From 990b01ea3e7472f96bf2bd55368d1251b018b6f6 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sat, 14 Jan 2017 13:20:20 +0300 Subject: [PATCH 02/23] write lazy early return functions for SimplifyName analyzer --- src/fsharp/NameResolution.fs | 384 ++++++++++++++++++++++++++++++++++ src/fsharp/NameResolution.fsi | 4 +- src/fsharp/vs/service.fs | 17 +- 3 files changed, 396 insertions(+), 9 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 80cd40d4a1a..c3f2c90b4b5 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -3904,3 +3904,387 @@ let GetVisibleNamespacesAndModulesAtPoint (ncenv: NameResolver) (nenv: NameResol IsInterestingModuleName demangledName && notFakeContainerModule ilTyconNames demangledName && EntityRefContainsSomethingAccessible ncenv m ad x && not (IsTyconUnseen ad ncenv.g ncenv.amap m x)) + + +let private ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics typ (item: Item) : seq = + seq { + let g = ncenv.g + let amap = ncenv.amap + + match item with + | Item.RecdField _ -> + yield! + ncenv.InfoReader.GetRecordOrClassFieldsOfType(None,ad,m,typ) + |> List.filter (fun rfref -> rfref.IsStatic = statics && IsFieldInfoAccessible ad rfref) + |> List.map Item.RecdField + | Item.UnionCase _ -> + if statics && isAppTy g typ then + let tc, tinst = destAppTy g typ + yield! + tc.UnionCasesAsRefList + |> List.filter (IsUnionCaseUnseen ad g ncenv.amap m >> not) + |> List.map (fun ucref -> Item.UnionCase(UnionCaseInfo(tinst,ucref),false)) + | Item.Event _ -> + yield! + ncenv.InfoReader.GetEventInfosOfType(None,ad,m,typ) + |> List.filter (fun x -> + IsStandardEventInfo ncenv.InfoReader m ad x && + x.IsStatic = statics) + |> List.map Item.Event + | Item.ILField _ -> + yield! + ncenv.InfoReader.GetILFieldInfosOfType(None,ad,m,typ) + |> List.filter (fun x -> + not x.IsSpecialName && + x.IsStatic = statics && + IsILFieldInfoAccessible g amap m ad x) + |> List.map Item.ILField + | Item.Types _ -> + if statics then + yield! typ |> GetNestedTypesOfType (ad, ncenv, None, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) |> List.map (ItemOfTy g) + | _ -> + let pinfosIncludingUnseen = + AllPropInfosOfTypeInScope ncenv.InfoReader nenv (None,ad) PreferOverrides m typ + |> List.filter (fun x -> + x.IsStatic = statics && + IsPropInfoAccessible g amap m ad x) + + // Exclude get_ and set_ methods accessed by properties + let pinfoMethNames = + (pinfosIncludingUnseen + |> List.filter (fun pinfo -> pinfo.HasGetter) + |> List.map (fun pinfo -> pinfo.GetterMethod.LogicalName)) + @ + (pinfosIncludingUnseen + |> List.filter (fun pinfo -> pinfo.HasSetter) + |> List.map (fun pinfo -> pinfo.SetterMethod.LogicalName)) + + let einfoMethNames = + let einfos = + ncenv.InfoReader.GetEventInfosOfType(None,ad,m,typ) + |> List.filter (fun x -> + IsStandardEventInfo ncenv.InfoReader m ad x && + x.IsStatic = statics) + + [ for einfo in einfos do + let delegateType = einfo.GetDelegateType(amap, m) + let (SigOfFunctionForDelegate(invokeMethInfo,_,_,_)) = GetSigOfFunctionForDelegate ncenv.InfoReader delegateType m ad + // Only events with void return types are suppressed in intellisense. + if slotSigHasVoidReturnTy (invokeMethInfo.GetSlotSig(amap, m)) then + yield einfo.GetAddMethod().DisplayName + yield einfo.GetRemoveMethod().DisplayName ] + + let suppressedMethNames = Zset.ofList String.order (pinfoMethNames @ einfoMethNames) + + let pinfos = + pinfosIncludingUnseen + |> List.filter (fun x -> not (PropInfoIsUnseen m x)) + + let minfoFilter (minfo: MethInfo) = + // Only show the Finalize, MemberwiseClose etc. methods on System.Object for values whose static type really is + // System.Object. Few of these are typically used from F#. + // + // Don't show GetHashCode or Equals for F# types that admit equality as an abnormal operation + let isUnseenDueToBasicObjRules = + not (isObjTy g typ) && + not minfo.IsExtensionMember && + match minfo.LogicalName with + | "GetType" -> false + | "GetHashCode" -> isObjTy g minfo.EnclosingType && not (AugmentWithHashCompare.TypeDefinitelyHasEquality g typ) + | "ToString" -> false + | "Equals" -> + if not (isObjTy g minfo.EnclosingType) then + // declaring type is not System.Object - show it + false + elif minfo.IsInstance then + // System.Object has only one instance Equals method and we want to suppress it unless Augment.TypeDefinitelyHasEquality is true + not (AugmentWithHashCompare.TypeDefinitelyHasEquality g typ) + else + // System.Object has only one static Equals method and we always want to suppress it + true + | _ -> + // filter out self methods of obj type + isObjTy g minfo.EnclosingType + let result = + not isUnseenDueToBasicObjRules && + not minfo.IsInstance = statics && + IsMethInfoAccessible amap m ad minfo && + not (MethInfoIsUnseen g m typ minfo) && + not minfo.IsConstructor && + not minfo.IsClassConstructor && + not (minfo.LogicalName = ".cctor") && + not (minfo.LogicalName = ".ctor") && + not (suppressedMethNames.Contains minfo.LogicalName) + result + + let pinfoItems = + pinfos + |> List.choose (fun pinfo-> + let pinfoOpt = DecodeFSharpEvent [pinfo] ad g ncenv m + match pinfoOpt with + | Some(Item.Event einfo) -> if IsStandardEventInfo ncenv.InfoReader m ad einfo then pinfoOpt else None + | _ -> pinfoOpt) + + yield! pinfoItems + + match item with + | Item.MethodGroup _ -> + // REVIEW: add a name filter here in the common cases? + let minfos = + let minfos = + AllMethInfosOfTypeInScope ncenv.InfoReader nenv (None,ad) PreferOverrides m typ + |> List.filter minfoFilter + + let minfos = + let addersAndRemovers = + pinfoItems + |> List.collect (function Item.Event(FSEvent(_,_,addValRef,removeValRef)) -> [addValRef.LogicalName;removeValRef.LogicalName] | _ -> []) + |> set + + if addersAndRemovers.IsEmpty then minfos + else minfos |> List.filter (fun minfo -> not (addersAndRemovers.Contains minfo.LogicalName)) + + #if EXTENSIONTYPING + // Filter out the ones with mangled names from applying static parameters + let minfos = + let methsWithStaticParams = + minfos + |> List.filter (fun minfo -> + match minfo.ProvidedStaticParameterInfo with + | Some (_methBeforeArguments, staticParams) -> staticParams.Length <> 0 + | _ -> false) + |> List.map (fun minfo -> minfo.DisplayName) + + if methsWithStaticParams.IsEmpty then minfos + else minfos |> List.filter (fun minfo -> + let nm = minfo.LogicalName + not (nm.Contains "," && methsWithStaticParams |> List.exists (fun m -> nm.StartsWith(m)))) + #endif + + minfos + + // Partition methods into overload sets + let rec partitionl (l:MethInfo list) acc = + match l with + | [] -> acc + | h::t -> + let nm = h.LogicalName + partitionl t (NameMultiMap.add nm h acc) + + yield! List.map Item.MakeMethGroup (NameMap.toList (partitionl minfos Map.empty)) + | _ -> () + } + +let rec private ResolvePartialLongIdentInTypeForItem (ncenv: NameResolver) nenv m ad statics plid (item: Item) typ = + seq { + let g = ncenv.g + let amap = ncenv.amap + + match plid with + | [] -> yield! ResolveCompletionsInTypeForItem ncenv nenv m ad statics typ item + | id :: rest -> + + let rfinfos = + ncenv.InfoReader.GetRecordOrClassFieldsOfType(None,ad,m,typ) + |> List.filter (fun fref -> IsRecdFieldAccessible ncenv.amap m ad fref.RecdFieldRef) + |> List.filter (fun fref -> fref.RecdField.IsStatic = statics) + + let nestedTypes = typ |> GetNestedTypesOfType (ad, ncenv, Some id, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) + + // e.g. .. + for rfinfo in rfinfos do + if rfinfo.Name = id then + yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad false rest item rfinfo.FieldType + + // e.g. .. + let fullTypeOfPinfo (pinfo: PropInfo) = + let rty = pinfo.GetPropertyType(amap,m) + let rty = if pinfo.IsIndexer then mkRefTupledTy g (pinfo.GetParamTypes(amap, m)) --> rty else rty + rty + + let pinfos = + typ + |> AllPropInfosOfTypeInScope ncenv.InfoReader nenv (Some id,ad) IgnoreOverrides m + |> List.filter (fun x -> x.IsStatic = statics) + |> List.filter (IsPropInfoAccessible g amap m ad) + + for pinfo in pinfos do + yield! (fullTypeOfPinfo pinfo) |> ResolvePartialLongIdentInTypeForItem ncenv nenv m ad false rest item + + // e.g. .. + for einfo in ncenv.InfoReader.GetEventInfosOfType(Some id, ad, m, typ) do + let tyinfo = PropTypOfEventInfo ncenv.InfoReader m ad einfo + yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad false rest item tyinfo + + // nested types! + for ty in nestedTypes do + yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad statics rest item ty + + // e.g. .. + for finfo in ncenv.InfoReader.GetILFieldInfosOfType(Some id, ad, m, typ) do + if not finfo.IsSpecialName && finfo.IsStatic = statics && IsILFieldInfoAccessible g amap m ad finfo then + yield! finfo.FieldType(amap, m) |> ResolvePartialLongIdentInTypeForItem ncenv nenv m ad false rest item + } + +let rec private ResolvePartialLongIdentInModuleOrNamespaceForItem (ncenv: NameResolver) nenv m ad (modref: ModuleOrNamespaceRef) plid (item: Item) = + let g = ncenv.g + let mty = modref.ModuleOrNamespaceType + + seq { + match plid with + | [] -> + match item with + | Item.Value _ -> + // Collect up the accessible values in the module, excluding the members + yield! + mty.AllValsAndMembers + |> Seq.toList + |> List.choose (TryMkValRefInModRef modref) // if the assembly load set is incomplete and we get a None value here, then ignore the value + |> List.filter (fun v -> v.MemberInfo.IsNone) + |> List.filter (IsValUnseen ad g m >> not) + |> List.map Item.Value + | Item.UnionCase _ -> + // Collect up the accessible discriminated union cases in the module + yield! + UnionCaseRefsInModuleOrNamespace modref + |> List.filter (IsUnionCaseUnseen ad g ncenv.amap m >> not) + |> List.map (fun x -> Item.UnionCase(GeneralizeUnionCaseRef x, false)) + | Item.ActivePatternCase _ -> + // Collect up the accessible active patterns in the module + yield! + ActivePatternElemsOfModuleOrNamespace modref + |> NameMap.range + |> List.filter (fun apref -> apref.ActivePatternVal |> IsValUnseen ad g m |> not) + |> List.map Item.ActivePatternCase + | Item.ExnCase _ -> + // Collect up the accessible F# exception declarations in the module + yield! + mty.ExceptionDefinitionsByDemangledName + |> NameMap.range + |> List.map modref.NestedTyconRef + |> List.filter (IsTyconUnseen ad g ncenv.amap m >> not) + |> List.map Item.ExnCase + | _ -> + let ilTyconNames = + mty.TypesByAccessNames.Values + |> List.choose (fun (tycon:Tycon) -> if tycon.IsILTycon then Some tycon.DisplayName else None) + |> Set.ofList + + // Collect up the accessible sub-modules. We must yield them even though `item` is not a module or namespace, + // otherwise we would not resolve long idents which have modules and namespaces in the middle (i.e. all long idents) + yield! + mty.ModulesAndNamespacesByDemangledName + |> NameMap.range + |> List.filter (fun x -> + let demangledName = x.DemangledModuleOrNamespaceName + notFakeContainerModule ilTyconNames demangledName && IsInterestingModuleName demangledName) + |> List.map modref.NestedTyconRef + |> List.filter (IsTyconUnseen ad g ncenv.amap m >> not) + |> List.filter (EntityRefContainsSomethingAccessible ncenv m ad) + |> List.map ItemForModuleOrNamespaceRef + let tycons = + mty.TypeDefinitions + |> List.filter (fun tcref -> not (tcref.LogicalName.Contains(","))) + |> List.filter (fun tycon -> not (IsTyconUnseen ad g ncenv.amap m (modref.NestedTyconRef tycon))) + + // Get all the types and .NET constructor groups accessible from here + yield! tycons |> List.map (modref.NestedTyconRef >> ItemOfTyconRef ncenv m) + yield! tycons |> List.collect (modref.NestedTyconRef >> InfosForTyconConstructors ncenv m ad) + + | id :: rest -> + + match mty.ModulesAndNamespacesByDemangledName.TryFind(id) with + | Some mspec + when not (IsTyconUnseenObsoleteSpec ad g ncenv.amap m (modref.NestedTyconRef mspec) true) -> + yield! ResolvePartialLongIdentInModuleOrNamespaceForItem ncenv nenv m ad (modref.NestedTyconRef mspec) rest item + | _ -> () + + for tycon in LookupTypeNameInEntityNoArity m id modref.ModuleOrNamespaceType do + let tcref = modref.NestedTyconRef tycon + if not (IsTyconUnseenObsoleteSpec ad g ncenv.amap m tcref true) then + yield! tcref |> generalizedTyconRef |> ResolvePartialLongIdentInTypeForItem ncenv nenv m ad true rest item + } + +let rec private GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolutionEnv) m ad plid (item: Item) : seq = + seq { + let g = ncenv.g + + match plid with + | "global" :: plid -> // this is deliberately not the mangled name + + yield! GetCompletionForItem ncenv nenv m ad plid item + + | [] -> + + /// Include all the entries in the eUnqualifiedItems table. + yield! + nenv.eUnqualifiedItems.Values + |> List.filter (function Item.UnqualifiedType _ -> false | _ -> true) + |> List.filter (ItemIsUnseen ad g ncenv.amap m >> not) + + match item with + | Item.ModuleOrNamespaces _ -> + let ilTyconNames = + nenv.TyconsByAccessNames(OpenQualified).Values + |> List.choose (fun tyconRef -> if tyconRef.IsILTycon then Some tyconRef.DisplayName else None) + |> Set.ofList + + for ns in NameMultiMap.range (nenv.ModulesAndNamespaces(OpenQualified)) do + let demangledName = ns.DemangledModuleOrNamespaceName + if IsInterestingModuleName demangledName && notFakeContainerModule ilTyconNames demangledName + && EntityRefContainsSomethingAccessible ncenv m ad ns + && not (IsTyconUnseen ad g ncenv.amap m ns) + then yield ItemForModuleOrNamespaceRef ns + + | Item.Types _ -> + for tcref in nenv.TyconsByDemangledNameAndArity(OpenQualified).Values do + if not tcref.IsExceptionDecl + && not (tcref.LogicalName.Contains ",") + && not (IsTyconUnseen ad g ncenv.amap m tcref) + then yield ItemOfTyconRef ncenv m tcref + + | Item.ActivePatternCase _ -> + yield! + nenv.ePatItems + |> NameMap.range + |> List.filter (function Item.ActivePatternCase _v -> true | _ -> false) + + | _ -> + for tcref in nenv.TyconsByDemangledNameAndArity(OpenQualified).Values do + if not (IsTyconUnseen ad g ncenv.amap m tcref) + then yield! InfosForTyconConstructors ncenv m ad tcref + + | id :: rest -> + + // Look in the namespaces 'id' + yield! + PartialResolveLongIndentAsModuleOrNamespaceThen nenv [id] (fun modref -> + if EntityRefContainsSomethingAccessible ncenv m ad modref then + ResolvePartialLongIdentInModuleOrNamespaceForItem ncenv nenv m ad modref rest item |> Seq.toList + else []) + + // Look for values called 'id' that accept the dot-notation + let values, isItemVal = + (if nenv.eUnqualifiedItems.ContainsKey(id) then + // v.lookup : member of a value + let v = nenv.eUnqualifiedItems.[id] + match v with + | Item.Value x -> + let typ = x.Type + let typ = if x.BaseOrThisInfo = CtorThisVal && isRefCellTy g typ then destRefCellTy g typ else typ + (ResolvePartialLongIdentInTypeForItem ncenv nenv m ad false rest item typ), true + | _ -> Seq.empty, false + else Seq.empty, false) + + yield! values + + if not isItemVal then + // type.lookup : lookup a static something in a type + for tcref in LookupTypeNameInEnvNoArity OpenQualified id nenv do + let tcref = ResolveNestedTypeThroughAbbreviation ncenv tcref m + let typ = FreshenTycon ncenv m tcref + yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad true rest item typ + } + +let IsItemResolvable (ncenv: NameResolver) (nenv: NameResolutionEnv) m ad plid (item: Item) : bool = + GetCompletionForItem ncenv nenv m ad plid item |> Seq.exists (ItemsAreEffectivelyEqual ncenv.g item) \ No newline at end of file diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index db3409e99ed..87b440ae692 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -418,4 +418,6 @@ type ResolveCompletionTargets = /// Resolve a (possibly incomplete) long identifier to a set of possible resolutions, qualified by type. val ResolveCompletionsInType : NameResolver -> NameResolutionEnv -> ResolveCompletionTargets -> Range.range -> AccessorDomain -> bool -> TType -> Item list -val GetVisibleNamespacesAndModulesAtPoint : NameResolver -> NameResolutionEnv -> range -> AccessorDomain -> ModuleOrNamespaceRef list \ No newline at end of file +val GetVisibleNamespacesAndModulesAtPoint : NameResolver -> NameResolutionEnv -> range -> AccessorDomain -> ModuleOrNamespaceRef list + +val IsItemResolvable : NameResolver -> NameResolutionEnv -> range -> AccessorDomain -> string list -> Item -> bool \ No newline at end of file diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index 70c0980797a..af0cf5659b5 100644 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -520,19 +520,19 @@ type TypeCheckInfo /// Find the most precise naming environment for the given line and column let GetBestEnvForPos cursorPos = - let bestSoFar = ref None + let mutable bestSoFar = None // Find the most deeply nested enclosing scope that contains given position sResolutions.CapturedEnvs |> ResizeArray.iter (fun (possm,env,ad) -> if rangeContainsPos possm cursorPos then - match !bestSoFar with + match bestSoFar with | Some (bestm,_,_) -> if rangeContainsRange bestm possm then - bestSoFar := Some (possm,env,ad) + bestSoFar <- Some (possm,env,ad) | None -> - bestSoFar := Some (possm,env,ad)) + bestSoFar <- Some (possm,env,ad)) - let mostDeeplyNestedEnclosingScope = !bestSoFar + let mostDeeplyNestedEnclosingScope = bestSoFar // Look for better subtrees on the r.h.s. of the subtree to the left of where we are // Should really go all the way down the r.h.s. of the subtree to the left of where we are @@ -1122,9 +1122,10 @@ type TypeCheckInfo member x.IsRelativeNameResolvable(cursorPos: pos, plid: string list, item: Item) : bool = /// Find items in the best naming environment. let (nenv, ad), m = GetBestEnvForPos cursorPos - let items = NameResolution.ResolvePartialLongIdent ncenv nenv (ConstraintSolver.IsApplicableMethApprox g amap m) m ad plid true - - items |> List.exists (ItemsAreEffectivelyEqual g item) + NameResolution.IsItemResolvable ncenv nenv m ad plid item + + //let items = NameResolution.ResolvePartialLongIdent ncenv nenv (fun _ _ -> true) m ad plid true + //items |> List.exists (ItemsAreEffectivelyEqual g item) /// Get the auto-complete items at a location member x.GetDeclarations (parseResultsOpt, line, lineStr, colAtEndOfNamesAndResidue, qualifyingNames, partialName, hasTextChangedSinceLastTypecheck) = From 0982b9230ac4aa936a4594f9804ef7d72f064a8a Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sat, 14 Jan 2017 14:12:56 +0300 Subject: [PATCH 03/23] make the rest of nr lazy add cache --- src/fsharp/NameResolution.fs | 29 ++++- .../SimplifyNameDiagnosticAnalyzer.fs | 123 ++++++++++-------- 2 files changed, 94 insertions(+), 58 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index c3f2c90b4b5..660829efea9 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -3905,6 +3905,7 @@ let GetVisibleNamespacesAndModulesAtPoint (ncenv: NameResolver) (nenv: NameResol && EntityRefContainsSomethingAccessible ncenv m ad x && not (IsTyconUnseen ad ncenv.g ncenv.amap m x)) +(* Determining if an `Item` is resolvable at point by given `plid`. It's optimized by being lazy and early returning according to the given `Item` *) let private ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics typ (item: Item) : seq = seq { @@ -4205,6 +4206,28 @@ let rec private ResolvePartialLongIdentInModuleOrNamespaceForItem (ncenv: NameRe yield! tcref |> generalizedTyconRef |> ResolvePartialLongIdentInTypeForItem ncenv nenv m ad true rest item } +let rec private PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f plid (modref: ModuleOrNamespaceRef) = + let mty = modref.ModuleOrNamespaceType + match plid with + | [] -> f modref + | id :: rest -> + match mty.ModulesAndNamespacesByDemangledName.TryFind id with + | Some mty -> + PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f rest (modref.NestedTyconRef mty) + | None -> Seq.empty + +let private PartialResolveLongIndentAsModuleOrNamespaceThenLazy (nenv:NameResolutionEnv) plid f = + seq { + match plid with + | id :: rest -> + match Map.tryFind id nenv.eModulesAndNamespaces with + | Some modrefs -> + for modref in modrefs do + yield! PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f rest modref + | None -> () + | [] -> () + } + let rec private GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolutionEnv) m ad plid (item: Item) : seq = seq { let g = ncenv.g @@ -4258,10 +4281,10 @@ let rec private GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolution // Look in the namespaces 'id' yield! - PartialResolveLongIndentAsModuleOrNamespaceThen nenv [id] (fun modref -> + PartialResolveLongIndentAsModuleOrNamespaceThenLazy nenv [id] (fun modref -> if EntityRefContainsSomethingAccessible ncenv m ad modref then - ResolvePartialLongIdentInModuleOrNamespaceForItem ncenv nenv m ad modref rest item |> Seq.toList - else []) + ResolvePartialLongIdentInModuleOrNamespaceForItem ncenv nenv m ad modref rest item + else Seq.empty) // Look for values called 'id' that accept the dot-notation let values, isItemVal = diff --git a/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs b/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs index 357410745b7..80b604a64a1 100644 --- a/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs @@ -17,7 +17,7 @@ open Microsoft.FSharp.Compiler.SourceCodeServices open Microsoft.VisualStudio.FSharp.LanguageService -type private LineHash = int +type private TextVersionHash = int [] type internal SimplifyNameDiagnosticAnalyzer() = @@ -26,6 +26,7 @@ type internal SimplifyNameDiagnosticAnalyzer() = let getProjectInfoManager (document: Document) = document.Project.Solution.Workspace.Services.GetService().ProjectInfoManager let getChecker (document: Document) = document.Project.Solution.Workspace.Services.GetService().Checker let getPlidLength (plid: string list) = (plid |> List.sumBy String.length) + plid.Length + static let cache = ConditionalWeakTable>() static let Descriptor = DiagnosticDescriptor( @@ -47,63 +48,75 @@ type internal SimplifyNameDiagnosticAnalyzer() = asyncMaybe { match getProjectInfoManager(document).TryGetOptionsForEditingDocumentOrProject(document) with | Some options -> - let! sourceText = document.GetTextAsync() - let checker = getChecker document - let! _, checkResults = checker.ParseAndCheckDocument(document, options, sourceText) - let! symbolUses = checkResults.GetAllUsesOfAllSymbolsInFile() |> liftAsync - let mutable result = ResizeArray() - let symbolUses = - symbolUses - |> Array.Parallel.map (fun symbolUse -> - let lineStr = sourceText.Lines.[Line.toZ symbolUse.RangeAlternate.StartLine].ToString() - // for `System.DateTime.Now` it returns ([|"System"; "DateTime"|], "Now") - let plid, name = QuickParse.GetPartialLongNameEx(lineStr, symbolUse.RangeAlternate.EndColumn - 1) - // `symbolUse.RangeAlternate.Start` does not point to the start of plid, it points to start of `name`, - // so we have to calculate plid's start ourselves. - let plidStartCol = symbolUse.RangeAlternate.EndColumn - name.Length - (getPlidLength plid) - symbolUse, plid, plidStartCol, name) - |> Array.filter (fun (_, plid, _, _) -> not (List.isEmpty plid)) - |> Array.groupBy (fun (symbolUse, _, plidStartCol, _) -> symbolUse.RangeAlternate.StartLine, plidStartCol) - |> Array.map (fun (_, xs) -> xs |> Array.maxBy (fun (symbolUse, _, _, _) -> symbolUse.RangeAlternate.EndColumn)) + let! textVersion = document.GetTextVersionAsync(cancellationToken) + let textVersionHash = textVersion.GetHashCode() - for symbolUse, plid, plidStartCol, name in symbolUses do - if not symbolUse.IsFromDefinition then - let posAtStartOfName = - let r = symbolUse.RangeAlternate - if r.StartLine = r.EndLine then Range.mkPos r.StartLine (r.EndColumn - name.Length) - else r.Start - - let getNecessaryPlid (plid: string list) : Async = - let rec loop (rest: string list) (current: string list) = - async { - match rest with - | [] -> return current - | headIdent :: restPlid -> - let! res = checkResults.IsRelativeNameResolvable(posAtStartOfName, current, symbolUse.Symbol.Item) - if res then return current - else return! loop restPlid (headIdent :: current) - } - loop (List.rev plid) [] - - let! necessaryPlid = getNecessaryPlid plid |> liftAsync + return! lock cache (fun _ -> + asyncMaybe { + match cache.TryGetValue document.Id with + | true, (oldTextVersionHash, diagnostics) when oldTextVersionHash = textVersionHash -> return diagnostics + | _ -> + let! sourceText = document.GetTextAsync() + let checker = getChecker document + let! _, checkResults = checker.ParseAndCheckDocument(document, options, sourceText) + let! symbolUses = checkResults.GetAllUsesOfAllSymbolsInFile() |> liftAsync + let mutable result = ResizeArray() + let symbolUses = + symbolUses + |> Array.Parallel.map (fun symbolUse -> + let lineStr = sourceText.Lines.[Line.toZ symbolUse.RangeAlternate.StartLine].ToString() + // for `System.DateTime.Now` it returns ([|"System"; "DateTime"|], "Now") + let plid, name = QuickParse.GetPartialLongNameEx(lineStr, symbolUse.RangeAlternate.EndColumn - 1) + // `symbolUse.RangeAlternate.Start` does not point to the start of plid, it points to start of `name`, + // so we have to calculate plid's start ourselves. + let plidStartCol = symbolUse.RangeAlternate.EndColumn - name.Length - (getPlidLength plid) + symbolUse, plid, plidStartCol, name) + |> Array.filter (fun (_, plid, _, _) -> not (List.isEmpty plid)) + |> Array.groupBy (fun (symbolUse, _, plidStartCol, _) -> symbolUse.RangeAlternate.StartLine, plidStartCol) + |> Array.map (fun (_, xs) -> xs |> Array.maxBy (fun (symbolUse, _, _, _) -> symbolUse.RangeAlternate.EndColumn)) - match necessaryPlid with - | necessaryPlid when necessaryPlid = plid -> () - | necessaryPlid -> - let r = symbolUse.RangeAlternate - let necessaryPlidStartCol = r.EndColumn - name.Length - (getPlidLength necessaryPlid) - - let unnecessaryRange = - Range.mkRange r.FileName (Range.mkPos r.StartLine plidStartCol) (Range.mkPos r.EndLine necessaryPlidStartCol) + for symbolUse, plid, plidStartCol, name in symbolUses do + if not symbolUse.IsFromDefinition then + let posAtStartOfName = + let r = symbolUse.RangeAlternate + if r.StartLine = r.EndLine then Range.mkPos r.StartLine (r.EndColumn - name.Length) + else r.Start - let relativeName = (String.concat "." plid) + "." + name - result.Add( - Diagnostic.Create( - Descriptor, - CommonRoslynHelpers.RangeToLocation(unnecessaryRange, sourceText, document.FilePath), - properties = (dict [SimplifyNameDiagnosticAnalyzer.LongIdentPropertyKey, relativeName]).ToImmutableDictionary())) - - return result.ToImmutableArray() + let getNecessaryPlid (plid: string list) : Async = + let rec loop (rest: string list) (current: string list) = + async { + match rest with + | [] -> return current + | headIdent :: restPlid -> + let! res = checkResults.IsRelativeNameResolvable(posAtStartOfName, current, symbolUse.Symbol.Item) + if res then return current + else return! loop restPlid (headIdent :: current) + } + loop (List.rev plid) [] + + let! necessaryPlid = getNecessaryPlid plid |> liftAsync + + match necessaryPlid with + | necessaryPlid when necessaryPlid = plid -> () + | necessaryPlid -> + let r = symbolUse.RangeAlternate + let necessaryPlidStartCol = r.EndColumn - name.Length - (getPlidLength necessaryPlid) + + let unnecessaryRange = + Range.mkRange r.FileName (Range.mkPos r.StartLine plidStartCol) (Range.mkPos r.EndLine necessaryPlidStartCol) + + let relativeName = (String.concat "." plid) + "." + name + result.Add( + Diagnostic.Create( + Descriptor, + CommonRoslynHelpers.RangeToLocation(unnecessaryRange, sourceText, document.FilePath), + properties = (dict [SimplifyNameDiagnosticAnalyzer.LongIdentPropertyKey, relativeName]).ToImmutableDictionary())) + + let diagnostics = result.ToImmutableArray() + cache.Remove(document.Id) |> ignore + cache.Add(document.Id, (textVersionHash, diagnostics)) + return diagnostics + }) | None -> return ImmutableArray.Empty } |> Async.map (Option.defaultValue ImmutableArray.Empty) From f6d4a7d9980256bc6a4e89579478a9e7f76194e7 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sat, 14 Jan 2017 15:08:46 +0300 Subject: [PATCH 04/23] fix cache locking --- .../SimplifyNameDiagnosticAnalyzer.fs | 134 +++++++++--------- 1 file changed, 67 insertions(+), 67 deletions(-) diff --git a/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs b/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs index 80b604a64a1..9de87fda100 100644 --- a/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs @@ -27,6 +27,7 @@ type internal SimplifyNameDiagnosticAnalyzer() = let getChecker (document: Document) = document.Project.Solution.Workspace.Services.GetService().Checker let getPlidLength (plid: string list) = (plid |> List.sumBy String.length) + plid.Length static let cache = ConditionalWeakTable>() + static let guard = new SemaphoreSlim(1) static let Descriptor = DiagnosticDescriptor( @@ -50,73 +51,72 @@ type internal SimplifyNameDiagnosticAnalyzer() = | Some options -> let! textVersion = document.GetTextVersionAsync(cancellationToken) let textVersionHash = textVersion.GetHashCode() - - return! lock cache (fun _ -> - asyncMaybe { - match cache.TryGetValue document.Id with - | true, (oldTextVersionHash, diagnostics) when oldTextVersionHash = textVersionHash -> return diagnostics - | _ -> - let! sourceText = document.GetTextAsync() - let checker = getChecker document - let! _, checkResults = checker.ParseAndCheckDocument(document, options, sourceText) - let! symbolUses = checkResults.GetAllUsesOfAllSymbolsInFile() |> liftAsync - let mutable result = ResizeArray() - let symbolUses = - symbolUses - |> Array.Parallel.map (fun symbolUse -> - let lineStr = sourceText.Lines.[Line.toZ symbolUse.RangeAlternate.StartLine].ToString() - // for `System.DateTime.Now` it returns ([|"System"; "DateTime"|], "Now") - let plid, name = QuickParse.GetPartialLongNameEx(lineStr, symbolUse.RangeAlternate.EndColumn - 1) - // `symbolUse.RangeAlternate.Start` does not point to the start of plid, it points to start of `name`, - // so we have to calculate plid's start ourselves. - let plidStartCol = symbolUse.RangeAlternate.EndColumn - name.Length - (getPlidLength plid) - symbolUse, plid, plidStartCol, name) - |> Array.filter (fun (_, plid, _, _) -> not (List.isEmpty plid)) - |> Array.groupBy (fun (symbolUse, _, plidStartCol, _) -> symbolUse.RangeAlternate.StartLine, plidStartCol) - |> Array.map (fun (_, xs) -> xs |> Array.maxBy (fun (symbolUse, _, _, _) -> symbolUse.RangeAlternate.EndColumn)) - - for symbolUse, plid, plidStartCol, name in symbolUses do - if not symbolUse.IsFromDefinition then - let posAtStartOfName = - let r = symbolUse.RangeAlternate - if r.StartLine = r.EndLine then Range.mkPos r.StartLine (r.EndColumn - name.Length) - else r.Start - - let getNecessaryPlid (plid: string list) : Async = - let rec loop (rest: string list) (current: string list) = - async { - match rest with - | [] -> return current - | headIdent :: restPlid -> - let! res = checkResults.IsRelativeNameResolvable(posAtStartOfName, current, symbolUse.Symbol.Item) - if res then return current - else return! loop restPlid (headIdent :: current) - } - loop (List.rev plid) [] - - let! necessaryPlid = getNecessaryPlid plid |> liftAsync - - match necessaryPlid with - | necessaryPlid when necessaryPlid = plid -> () - | necessaryPlid -> - let r = symbolUse.RangeAlternate - let necessaryPlidStartCol = r.EndColumn - name.Length - (getPlidLength necessaryPlid) - - let unnecessaryRange = - Range.mkRange r.FileName (Range.mkPos r.StartLine plidStartCol) (Range.mkPos r.EndLine necessaryPlidStartCol) - - let relativeName = (String.concat "." plid) + "." + name - result.Add( - Diagnostic.Create( - Descriptor, - CommonRoslynHelpers.RangeToLocation(unnecessaryRange, sourceText, document.FilePath), - properties = (dict [SimplifyNameDiagnosticAnalyzer.LongIdentPropertyKey, relativeName]).ToImmutableDictionary())) - - let diagnostics = result.ToImmutableArray() - cache.Remove(document.Id) |> ignore - cache.Add(document.Id, (textVersionHash, diagnostics)) - return diagnostics - }) + let! _ = guard.WaitAsync(cancellationToken) |> Async.AwaitTask |> liftAsync + try + match cache.TryGetValue document.Id with + | true, (oldTextVersionHash, diagnostics) when oldTextVersionHash = textVersionHash -> return diagnostics + | _ -> + let! sourceText = document.GetTextAsync() + let checker = getChecker document + let! _, checkResults = checker.ParseAndCheckDocument(document, options, sourceText) + let! symbolUses = checkResults.GetAllUsesOfAllSymbolsInFile() |> liftAsync + let mutable result = ResizeArray() + let symbolUses = + symbolUses + |> Array.Parallel.map (fun symbolUse -> + let lineStr = sourceText.Lines.[Line.toZ symbolUse.RangeAlternate.StartLine].ToString() + // for `System.DateTime.Now` it returns ([|"System"; "DateTime"|], "Now") + let plid, name = QuickParse.GetPartialLongNameEx(lineStr, symbolUse.RangeAlternate.EndColumn - 1) + // `symbolUse.RangeAlternate.Start` does not point to the start of plid, it points to start of `name`, + // so we have to calculate plid's start ourselves. + let plidStartCol = symbolUse.RangeAlternate.EndColumn - name.Length - (getPlidLength plid) + symbolUse, plid, plidStartCol, name) + |> Array.filter (fun (_, plid, _, _) -> not (List.isEmpty plid)) + |> Array.groupBy (fun (symbolUse, _, plidStartCol, _) -> symbolUse.RangeAlternate.StartLine, plidStartCol) + |> Array.map (fun (_, xs) -> xs |> Array.maxBy (fun (symbolUse, _, _, _) -> symbolUse.RangeAlternate.EndColumn)) + + for symbolUse, plid, plidStartCol, name in symbolUses do + if not symbolUse.IsFromDefinition then + let posAtStartOfName = + let r = symbolUse.RangeAlternate + if r.StartLine = r.EndLine then Range.mkPos r.StartLine (r.EndColumn - name.Length) + else r.Start + + let getNecessaryPlid (plid: string list) : Async = + let rec loop (rest: string list) (current: string list) = + async { + match rest with + | [] -> return current + | headIdent :: restPlid -> + let! res = checkResults.IsRelativeNameResolvable(posAtStartOfName, current, symbolUse.Symbol.Item) + if res then return current + else return! loop restPlid (headIdent :: current) + } + loop (List.rev plid) [] + + let! necessaryPlid = getNecessaryPlid plid |> liftAsync + + match necessaryPlid with + | necessaryPlid when necessaryPlid = plid -> () + | necessaryPlid -> + let r = symbolUse.RangeAlternate + let necessaryPlidStartCol = r.EndColumn - name.Length - (getPlidLength necessaryPlid) + + let unnecessaryRange = + Range.mkRange r.FileName (Range.mkPos r.StartLine plidStartCol) (Range.mkPos r.EndLine necessaryPlidStartCol) + + let relativeName = (String.concat "." plid) + "." + name + result.Add( + Diagnostic.Create( + Descriptor, + CommonRoslynHelpers.RangeToLocation(unnecessaryRange, sourceText, document.FilePath), + properties = (dict [SimplifyNameDiagnosticAnalyzer.LongIdentPropertyKey, relativeName]).ToImmutableDictionary())) + + let diagnostics = result.ToImmutableArray() + cache.Remove(document.Id) |> ignore + cache.Add(document.Id, (textVersionHash, diagnostics)) + return diagnostics + finally guard.Release() |> ignore | None -> return ImmutableArray.Empty } |> Async.map (Option.defaultValue ImmutableArray.Empty) From 7eeb470c3e00aa45c9dd59dd432b6c416b15fc29 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sat, 14 Jan 2017 15:41:51 +0300 Subject: [PATCH 05/23] do not try to resolve ctors for non-ctor Item --- src/fsharp/NameResolution.fs | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 660829efea9..5d4fa93d4cb 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1730,8 +1730,8 @@ let private ResolveObjectConstructorPrim (ncenv:NameResolver) edenv resInfo m ad if isDelegateTy g typ then success (resInfo,Item.DelegateCtor typ) else - let ctorInfos = GetIntrinsicConstructorInfosOfType ncenv.InfoReader m typ - if isInterfaceTy g typ && isNil ctorInfos then + let ctorInfos = GetIntrinsicConstructorInfosOfType ncenv.InfoReader m typ + if isNil ctorInfos && isInterfaceTy g typ then success (resInfo, Item.FakeInterfaceCtor typ) else let defaultStructCtorInfo = @@ -4272,11 +4272,16 @@ let rec private GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolution |> NameMap.range |> List.filter (function Item.ActivePatternCase _v -> true | _ -> false) - | _ -> + | Item.DelegateCtor _ + | Item.FakeInterfaceCtor _ + | Item.CtorGroup _ + | Item.UnqualifiedType _ -> for tcref in nenv.TyconsByDemangledNameAndArity(OpenQualified).Values do if not (IsTyconUnseen ad g ncenv.amap m tcref) then yield! InfosForTyconConstructors ncenv m ad tcref - + + | _ -> () + | id :: rest -> // Look in the namespaces 'id' From 4fc2f9b8be6321f6546d27f8a9c8f26f2223edd4 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sat, 14 Jan 2017 21:16:59 +0300 Subject: [PATCH 06/23] more lazyness to NameResolution --- src/fsharp/NameResolution.fs | 21 ++++++++++++--------- src/fsharp/tast.fs | 2 +- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 5d4fa93d4cb..3c05722d1e6 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -3232,9 +3232,9 @@ let IsTyconUnseenObsoleteSpec ad g amap m (x:TyconRef) allowObsolete = let IsTyconUnseen ad g amap m (x:TyconRef) = IsTyconUnseenObsoleteSpec ad g amap m x false let IsValUnseen ad g m (v:ValRef) = - not (IsValAccessible ad v) || v.IsCompilerGenerated || v.Deref.IsClassConstructor || + not (IsValAccessible ad v) || CheckFSharpAttributesForUnseen g v.Attribs m let IsUnionCaseUnseen ad g amap m (ucref:UnionCaseRef) = @@ -4240,10 +4240,12 @@ let rec private GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolution | [] -> /// Include all the entries in the eUnqualifiedItems table. - yield! - nenv.eUnqualifiedItems.Values - |> List.filter (function Item.UnqualifiedType _ -> false | _ -> true) - |> List.filter (ItemIsUnseen ad g ncenv.amap m >> not) + for uitem in nenv.eUnqualifiedItems.Values do + match uitem with + | Item.UnqualifiedType _ -> () + | _ when not (ItemIsUnseen ad g ncenv.amap m uitem) -> + yield uitem + | _ -> () match item with | Item.ModuleOrNamespaces _ -> @@ -4267,10 +4269,11 @@ let rec private GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolution then yield ItemOfTyconRef ncenv m tcref | Item.ActivePatternCase _ -> - yield! - nenv.ePatItems - |> NameMap.range - |> List.filter (function Item.ActivePatternCase _v -> true | _ -> false) + for pitem in NameMap.range nenv.ePatItems do + match pitem with + | Item.ActivePatternCase _ -> + yield pitem + | _ -> () | Item.DelegateCtor _ | Item.FakeInterfaceCtor _ diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index 0485971c37f..61bfe6b1d3e 100755 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -4511,7 +4511,7 @@ let fullCompPathOfModuleOrNamespace (m:ModuleOrNamespace) = CompPath(scoref,cpath@[(m.LogicalName, m.ModuleOrNamespaceType.ModuleOrNamespaceKind)]) // Can cpath2 be accessed given a right to access cpath1. That is, is cpath2 a nested type or namespace of cpath1. Note order of arguments. -let canAccessCompPathFrom (CompPath(scoref1,cpath1)) (CompPath(scoref2,cpath2)) = +let inline canAccessCompPathFrom (CompPath(scoref1,cpath1)) (CompPath(scoref2,cpath2)) = let rec loop p1 p2 = match p1,p2 with | (a1,k1)::rest1, (a2,k2)::rest2 -> (a1=a2) && (k1=k2) && loop rest1 rest2 From c8edcc36e699b745dc11d118d00d6020cad9e7c1 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sat, 14 Jan 2017 23:49:08 +0300 Subject: [PATCH 07/23] optimize GetBestEnvForPos by indexing nameres environments (scopes) by line number --- src/fsharp/vs/service.fs | 61 +++++++++++-------- src/fsharp/vs/service.fsi | 5 +- .../SimplifyNameDiagnosticAnalyzer.fs | 4 +- 3 files changed, 44 insertions(+), 26 deletions(-) diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index af0cf5659b5..56368a8f1ba 100644 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -518,12 +518,13 @@ type TypeCheckInfo let ncenv = new NameResolver(g,amap,infoReader,NameResolution.FakeInstantiationGenerator) /// Find the most precise naming environment for the given line and column - let GetBestEnvForPos cursorPos = + let GetBestEnvForPos (envsByLine: ResizeArray []) (cursorPos: pos) = + // Find all scopes those contain given position let mutable bestSoFar = None // Find the most deeply nested enclosing scope that contains given position - sResolutions.CapturedEnvs |> ResizeArray.iter (fun (possm,env,ad) -> + envsByLine.[cursorPos.Line] |> ResizeArray.iter (fun (possm, env, ad) -> if rangeContainsPos possm cursorPos then match bestSoFar with | Some (bestm,_,_) -> @@ -540,36 +541,35 @@ type TypeCheckInfo // We guarantee to only refine to a more nested environment. It may not be strictly // the right environment, but will alwauys be at least as rich - let bestAlmostIncludedSoFar = ref None + let mutable bestAlmostIncludedSoFar = None - sResolutions.CapturedEnvs |> ResizeArray.iter (fun (possm,env,ad) -> + envsByLine.[cursorPos.Line] |> ResizeArray.iter (fun (possm, env, ad) -> // take only ranges that strictly do not include cursorPos (all ranges that touch cursorPos were processed during 'Strict Inclusion' part) - if rangeBeforePos possm cursorPos && not (posEq possm.End cursorPos) then + if not (posEq possm.End cursorPos) && rangeBeforePos possm cursorPos then let contained = match mostDeeplyNestedEnclosingScope with | Some (bestm,_,_) -> rangeContainsRange bestm possm | None -> true if contained then - match !bestAlmostIncludedSoFar with - | Some (rightm:range,_,_) -> + match bestAlmostIncludedSoFar with + | Some (rightm: range,_,_) -> if posGt possm.End rightm.End || (posEq possm.End rightm.End && posGt possm.Start rightm.Start) then - bestAlmostIncludedSoFar := Some (possm,env,ad) - | _ -> bestAlmostIncludedSoFar := Some (possm,env,ad)) + bestAlmostIncludedSoFar <- Some (possm,env,ad) + | _ -> bestAlmostIncludedSoFar <- Some (possm,env,ad)) let resEnv = - match !bestAlmostIncludedSoFar with - | Some (_m,env,ad) -> + match bestAlmostIncludedSoFar with + | Some (_,env,ad) -> env,ad | None -> match mostDeeplyNestedEnclosingScope with - | Some (_m,env,ad) -> + | Some (_,env,ad) -> env,ad | None -> - (sFallback,AccessibleFromSomeFSharpCode) + (sFallback, AccessibleFromSomeFSharpCode) let pm = mkRange mainInputFileName cursorPos cursorPos - resEnv,pm /// The items that come back from ResolveCompletionsInType are a bit @@ -789,9 +789,17 @@ type TypeCheckInfo if textChanged then GetPreciseCompletionListFromExprTypingsResult.NoneBecauseTypecheckIsStaleAndTextChanged else GetPreciseCompletionListFromExprTypingsResult.None + let GetEnvsByLine() : ResizeArray [] = + let maxLine = sResolutions.CapturedEnvs |> Seq.maxBy (fun (m, _, _) -> m.EndLine) |> fun (m, _, _) -> m.EndLine + let envsByLine = Array.init (maxLine + 1) (fun _ -> ResizeArray()) + for (m,_,_) as env in sResolutions.CapturedEnvs do + for line in m.StartLine..m.EndLine do + envsByLine.[line].Add env + envsByLine + /// Find items in the best naming environment. let GetEnvironmentLookupResolutions(cursorPos, plid, filterCtors, showObsolete) = - let (nenv,ad),m = GetBestEnvForPos cursorPos + let (nenv,ad),m = GetBestEnvForPos (GetEnvsByLine()) cursorPos let items = NameResolution.ResolvePartialLongIdent ncenv nenv (ConstraintSolver.IsApplicableMethApprox g amap m) m ad plid showObsolete let items = items |> RemoveDuplicateItems g let items = items |> RemoveExplicitlySuppressed g @@ -801,7 +809,7 @@ type TypeCheckInfo /// Find record fields in the best naming environment. let GetClassOrRecordFieldsEnvironmentLookupResolutions(cursorPos, plid, (_residue : string option)) = - let (nenv, ad),m = GetBestEnvForPos cursorPos + let (nenv, ad),m = GetBestEnvForPos (GetEnvsByLine()) cursorPos let items = NameResolution.ResolvePartialLongIdentToClassOrRecdFields ncenv nenv m ad plid false let items = items |> RemoveDuplicateItems g let items = items |> RemoveExplicitlySuppressed g @@ -994,7 +1002,7 @@ type TypeCheckInfo /// Get the auto-complete items at a particular location. let GetDeclItemsForNamesAtPosition(parseResultsOpt: FSharpParseFileResults option, origLongIdentOpt: string list option, residueOpt:string option, line:int, lineStr:string, colAtEndOfNamesAndResidue, filterCtors, resolveOverloads, hasTextChangedSinceLastTypecheck: (obj * range -> bool)) = - + let loc = match colAtEndOfNamesAndResidue with | pastEndOfLine when pastEndOfLine >= lineStr.Length -> lineStr.Length @@ -1025,7 +1033,7 @@ type TypeCheckInfo // Completion at ' { XXX = ... } " | Some(CompletionContext.RecordField(RecordContext.New(plid, residue))) -> - Some(GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, plid, residue)) + Some(GetClassOrRecordFieldsEnvironmentLookupResolutions( mkPos line loc, plid, residue)) // Completion at ' { XXX = ... with ... } " | Some(CompletionContext.RecordField(RecordContext.CopyOnUpdate(r, (plid, residue)))) -> @@ -1112,16 +1120,18 @@ type TypeCheckInfo else items - static let keywordTypes = Lexhelp.Keywords.keywordTypes + member x.GetSortedNameResolutionEnvironments() = GetEnvsByLine() + member x.GetVisibleNamespacesAndModulesAtPosition(cursorPos: pos) : ModuleOrNamespaceRef list = - let (nenv, ad), m = GetBestEnvForPos cursorPos + let (nenv, ad), m = GetBestEnvForPos (GetEnvsByLine()) cursorPos NameResolution.GetVisibleNamespacesAndModulesAtPoint ncenv nenv m ad - member x.IsRelativeNameResolvable(cursorPos: pos, plid: string list, item: Item) : bool = + + member x.IsRelativeNameResolvable(cursorPos: pos, plid: string list, item: Item, envsByLine: ResizeArray []) : bool = /// Find items in the best naming environment. - let (nenv, ad), m = GetBestEnvForPos cursorPos + let (nenv, ad), m = GetBestEnvForPos envsByLine cursorPos NameResolution.IsItemResolvable ncenv nenv m ad plid item //let items = NameResolution.ResolvePartialLongIdent ncenv nenv (fun _ _ -> true) m ad plid true @@ -2057,8 +2067,11 @@ type FSharpCheckFileResults(errors: FSharpErrorInfo[], scopeOptX: TypeCheckInfo member info.GetVisibleNamespacesAndModulesAtPoint(pos: pos) : Async = reactorOp "GetDeclarations" [| |] (fun scope -> scope.GetVisibleNamespacesAndModulesAtPosition(pos) |> List.toArray) - member info.IsRelativeNameResolvable(pos: pos, plid: string list, item: Item) : Async = - reactorOp "IsRelativeNameResolvable" true (fun scope -> scope.IsRelativeNameResolvable(pos, plid, item)) + member info.GetNameResolutionEnvironmentsByLine() : Async []> = + reactorOp "IsRelativeNameResolvable" [||] (fun scope -> scope.GetSortedNameResolutionEnvironments()) + + member info.IsRelativeNameResolvable(pos: pos, plid: string list, item: Item, nenvsByLine: ResizeArray []) : Async = + reactorOp "IsRelativeNameResolvable" true (fun scope -> scope.IsRelativeNameResolvable(pos, plid, item, nenvsByLine)) //---------------------------------------------------------------------------- // BackgroundCompiler diff --git a/src/fsharp/vs/service.fsi b/src/fsharp/vs/service.fsi index 98471e1ee4c..7d10ecdae3c 100755 --- a/src/fsharp/vs/service.fsi +++ b/src/fsharp/vs/service.fsi @@ -14,6 +14,7 @@ open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.NameResolution open Microsoft.FSharp.Compiler.CompileOps +open Microsoft.FSharp.Compiler.AccessibilityLogic /// Represents one parameter for one method (or other item) in a group. [] @@ -285,7 +286,9 @@ type internal FSharpCheckFileResults = member GetVisibleNamespacesAndModulesAtPoint : pos -> Async - member IsRelativeNameResolvable: cursorPos : pos * plid : string list * item: Item -> Async + member IsRelativeNameResolvable: cursorPos : pos * plid : string list * item: Item * ResizeArray [] -> Async + + member GetNameResolutionEnvironmentsByLine : unit -> Async []> /// A handle to the results of CheckFileInProject. [] diff --git a/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs b/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs index 9de87fda100..aa51e4f429a 100644 --- a/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs @@ -75,6 +75,8 @@ type internal SimplifyNameDiagnosticAnalyzer() = |> Array.groupBy (fun (symbolUse, _, plidStartCol, _) -> symbolUse.RangeAlternate.StartLine, plidStartCol) |> Array.map (fun (_, xs) -> xs |> Array.maxBy (fun (symbolUse, _, _, _) -> symbolUse.RangeAlternate.EndColumn)) + let! nenvsByLine = checkResults.GetNameResolutionEnvironmentsByLine() |> liftAsync + for symbolUse, plid, plidStartCol, name in symbolUses do if not symbolUse.IsFromDefinition then let posAtStartOfName = @@ -88,7 +90,7 @@ type internal SimplifyNameDiagnosticAnalyzer() = match rest with | [] -> return current | headIdent :: restPlid -> - let! res = checkResults.IsRelativeNameResolvable(posAtStartOfName, current, symbolUse.Symbol.Item) + let! res = checkResults.IsRelativeNameResolvable(posAtStartOfName, current, symbolUse.Symbol.Item, nenvsByLine) if res then return current else return! loop restPlid (headIdent :: current) } From cba522623edf6039065e8f7434e8a049a13eeec5 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sun, 15 Jan 2017 11:26:04 +0300 Subject: [PATCH 08/23] look for best resolution env on previous line as well --- src/fsharp/vs/service.fs | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index 56368a8f1ba..5c90a8721e0 100644 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -520,11 +520,18 @@ type TypeCheckInfo /// Find the most precise naming environment for the given line and column let GetBestEnvForPos (envsByLine: ResizeArray []) (cursorPos: pos) = + let getEnvsOnLine line = + if line < 0 then ResizeArray() + elif line > envsByLine.Length - 1 then sResolutions.CapturedEnvs + else envsByLine.[line] + + let envsOnLine = getEnvsOnLine cursorPos.Line + // Find all scopes those contain given position let mutable bestSoFar = None // Find the most deeply nested enclosing scope that contains given position - envsByLine.[cursorPos.Line] |> ResizeArray.iter (fun (possm, env, ad) -> + envsOnLine |> ResizeArray.iter (fun (possm, env, ad) -> if rangeContainsPos possm cursorPos then match bestSoFar with | Some (bestm,_,_) -> @@ -541,9 +548,14 @@ type TypeCheckInfo // We guarantee to only refine to a more nested environment. It may not be strictly // the right environment, but will alwauys be at least as rich + let evnsOnLineAndPreviousLine = + let envs = getEnvsOnLine (cursorPos.Line - 1) + envs.AddRange(envsOnLine) + envs + let mutable bestAlmostIncludedSoFar = None - envsByLine.[cursorPos.Line] |> ResizeArray.iter (fun (possm, env, ad) -> + evnsOnLineAndPreviousLine |> ResizeArray.iter (fun (possm, env, ad) -> // take only ranges that strictly do not include cursorPos (all ranges that touch cursorPos were processed during 'Strict Inclusion' part) if not (posEq possm.End cursorPos) && rangeBeforePos possm cursorPos then let contained = From c30aab14f7cdb289453ca6392dd308e8a7cf85fe Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Sun, 15 Jan 2017 10:11:08 +0100 Subject: [PATCH 09/23] Reformat ResolveObjectConstructorPrim --- src/fsharp/NameResolution.fs | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 3c05722d1e6..a04d00a1864 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1735,8 +1735,12 @@ let private ResolveObjectConstructorPrim (ncenv:NameResolver) edenv resInfo m ad success (resInfo, Item.FakeInterfaceCtor typ) else let defaultStructCtorInfo = - if (isStructTy g typ && not (isRecdTy g typ) && not (isUnionTy g typ) && not(ctorInfos |> List.exists (fun x -> x.IsNullary))) then - [DefaultStructCtor(g,typ)] + if (not (ctorInfos |> List.exists (fun x -> x.IsNullary)) && + isStructTy g typ && + not (isRecdTy g typ) && + not (isUnionTy g typ)) + then + [DefaultStructCtor(g,typ)] else [] if (isNil defaultStructCtorInfo && isNil ctorInfos) || not (isAppTy g typ) then raze (Error(FSComp.SR.nrNoConstructorsAvailableForType(NicePrint.minimalStringOfType edenv typ),m)) From 9d5db9ad8955d850155be98fdafccbf2023a8883 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sun, 15 Jan 2017 13:29:44 +0300 Subject: [PATCH 10/23] remove double hash table lookup in NotifyNameResolution --- src/fsharp/NameResolution.fs | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index a04d00a1864..8a5d38be4d8 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1388,7 +1388,7 @@ type TcResultsSinkImpl(g, ?source: string) = let capturedNameResolutions = ResizeArray<_>() let capturedFormatSpecifierLocations = ResizeArray<_>() let capturedNameResolutionIdentifiers = - new System.Collections.Generic.Dictionary + new System.Collections.Generic.HashSet ( { new IEqualityComparer<_> with member __.GetHashCode((p:pos,i)) = p.Line + 101 * p.Column + hash i member __.Equals((p1,i1),(p2,i2)) = posEq p1 p2 && i1 = i2 } ) @@ -1423,10 +1423,7 @@ type TcResultsSinkImpl(g, ?source: string) = let alreadyDone = match keyOpt with - | Some key -> - let res = capturedNameResolutionIdentifiers.ContainsKey key - if not res then capturedNameResolutionIdentifiers.Add (key, ()) |> ignore - res + | Some key -> not (capturedNameResolutionIdentifiers.Add key) | _ -> false if replace then From a2f791dceccf6e243232cf4858a7e49654a4c741 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sun, 15 Jan 2017 13:56:59 +0300 Subject: [PATCH 11/23] make CurrentSink non-optional --- src/fsharp/NameResolution.fs | 103 +++++++++++++++++----------------- src/fsharp/NameResolution.fsi | 10 +++- src/fsharp/TypeChecker.fs | 65 ++++++++++----------- 3 files changed, 90 insertions(+), 88 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 8a5d38be4d8..5da2835b3c0 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1173,6 +1173,14 @@ type ITypecheckResultsSink = abstract NotifyNameResolution : pos * Item * Item * ItemOccurence * Tastops.DisplayEnv * NameResolutionEnv * AccessorDomain * range * bool -> unit abstract NotifyFormatSpecifierLocation : range -> unit abstract CurrentSource : string option + +let NoOpTypecheckResultSink = + { new ITypecheckResultsSink with + member __.NotifyEnvWithScope (_,_,_) = () + member __.NotifyExprHasType (_,_,_,_,_,_) = () + member __.NotifyNameResolution (_,_,_,_,_,_,_,_,_) = () + member __.NotifyFormatSpecifierLocation _ = () + member __.CurrentSource = None } let (|ValRefOfProp|_|) (pi : PropInfo) = pi.ArbitraryValRef let (|ValRefOfMeth|_|) (mi : MethInfo) = mi.ArbitraryValRef @@ -1442,46 +1450,40 @@ type TcResultsSinkImpl(g, ?source: string) = /// An abstract type for reporting the results of name resolution and type checking, and which allows /// temporary suspension and/or redirection of reporting. -type TcResultsSink = - { mutable CurrentSink : ITypecheckResultsSink option } - static member NoSink = { CurrentSink = None } - static member WithSink sink = { CurrentSink = Some sink } +type TcResultsSink = + { mutable CurrentSink : ITypecheckResultsSink } + +module TcResultsSink = + let NoSink = { CurrentSink = NoOpTypecheckResultSink } + let WithSink sink = { CurrentSink = sink } /// Temporarily redirect reporting of name resolution and type checking results let WithNewTypecheckResultsSink (newSink : ITypecheckResultsSink, sink:TcResultsSink) = let old = sink.CurrentSink - sink.CurrentSink <- Some newSink + sink.CurrentSink <- newSink { new System.IDisposable with member x.Dispose() = sink.CurrentSink <- old } /// Temporarily suspend reporting of name resolution and type checking results let TemporarilySuspendReportingTypecheckResultsToSink (sink:TcResultsSink) = let old = sink.CurrentSink - sink.CurrentSink <- None + sink.CurrentSink <- NoOpTypecheckResultSink { new System.IDisposable with member x.Dispose() = sink.CurrentSink <- old } /// Report the active name resolution environment for a specific source range let CallEnvSink (sink:TcResultsSink) (scopem,nenv,ad) = - match sink.CurrentSink with - | None -> () - | Some sink -> sink.NotifyEnvWithScope(scopem,nenv,ad) + sink.CurrentSink.NotifyEnvWithScope(scopem,nenv,ad) /// Report a specific name resolution at a source range let CallNameResolutionSink (sink:TcResultsSink) (m:range,nenv,item,itemMethodGroup,occurenceType,denv,ad) = - match sink.CurrentSink with - | None -> () - | Some sink -> sink.NotifyNameResolution(m.End,item,itemMethodGroup,occurenceType,denv,nenv,ad,m,false) + sink.CurrentSink.NotifyNameResolution(m.End,item,itemMethodGroup,occurenceType,denv,nenv,ad,m,false) let CallNameResolutionSinkReplacing (sink:TcResultsSink) (m:range,nenv,item,itemMethodGroup,occurenceType,denv,ad) = - match sink.CurrentSink with - | None -> () - | Some sink -> sink.NotifyNameResolution(m.End,item,itemMethodGroup,occurenceType,denv,nenv,ad,m,true) + sink.CurrentSink.NotifyNameResolution(m.End,item,itemMethodGroup,occurenceType,denv,nenv,ad,m,true) /// Report a specific expression typing at a source range let CallExprHasTypeSink (sink:TcResultsSink) (m:range,nenv,typ,denv,ad) = - match sink.CurrentSink with - | None -> () - | Some sink -> sink.NotifyExprHasType(m.End,typ,denv,nenv,ad,m) + sink.CurrentSink.NotifyExprHasType(m.End,typ,denv,nenv,ad,m) //------------------------------------------------------------------------- // Check inferability of type parameters in resolved items. @@ -3144,14 +3146,14 @@ let ResolveLongIdentAsExprAndComputeRange (sink:TcResultsSink) (ncenv:NameResolv if not isFakeIdents then CallNameResolutionSink sink (itemRange, nenv, refinedItem, item, ItemOccurence.Use, nenv.DisplayEnv, ad) let afterOverloadResolution = - match sink.CurrentSink with - | None -> AfterOverloadResolution.DoNothing - | Some _ -> - if NeedsOverloadResolution item then - AfterOverloadResolution.SendToSink(callSink, (fun () -> callSink item) |> IfOverloadResolutionFails) - else - callSink item - AfterOverloadResolution.DoNothing + if sink.CurrentSink = NoOpTypecheckResultSink then + AfterOverloadResolution.DoNothing + else + if NeedsOverloadResolution item then + AfterOverloadResolution.SendToSink(callSink, (fun () -> callSink item) |> IfOverloadResolutionFails) + else + callSink item + AfterOverloadResolution.DoNothing item, itemRange, rest, afterOverloadResolution let (|NonOverridable|_|) namedItem = @@ -3175,33 +3177,32 @@ let ResolveExprDotLongIdentAndComputeRange (sink:TcResultsSink) (ncenv:NameResol // Record the precise resolution of the field for intellisense/goto definition let afterOverloadResolution = - match sink.CurrentSink with - | None -> AfterOverloadResolution.DoNothing // do not retypecheck if nobody listens - | Some _ -> - // resolution for goto definition - let unrefinedItem,itemRange,overrides = - match findFlag, item with - | FindMemberFlag.PreferOverrides, _ - | _, NonOverridable() -> item,itemRange,false - | FindMemberFlag.IgnoreOverrides,_ -> - let _,item,_,itemRange = resolveExpr FindMemberFlag.PreferOverrides - item, itemRange,true - let sendToSink refinedItem = - let staticOnly = thisIsActuallyATyAppNotAnExpr - let refinedItem = FilterMethodGroups ncenv itemRange refinedItem staticOnly - let unrefinedItem = FilterMethodGroups ncenv itemRange unrefinedItem staticOnly - CallNameResolutionSink sink (itemRange, nenv, refinedItem, unrefinedItem, ItemOccurence.Use, nenv.DisplayEnv, ad) - match overrides,NeedsOverloadResolution unrefinedItem with - | false, true -> - AfterOverloadResolution.SendToSink(sendToSink, IfOverloadResolutionFails(fun () -> sendToSink unrefinedItem)) - | true, true -> - AfterOverloadResolution.ReplaceWithOverrideAndSendToSink(unrefinedItem,sendToSink, IfOverloadResolutionFails(fun () -> sendToSink unrefinedItem)) - | _ , false -> - sendToSink unrefinedItem - AfterOverloadResolution.DoNothing + if sink.CurrentSink = NoOpTypecheckResultSink then + AfterOverloadResolution.DoNothing // do not retypecheck if nobody listens + else + // resolution for goto definition + let unrefinedItem,itemRange,overrides = + match findFlag, item with + | FindMemberFlag.PreferOverrides, _ + | _, NonOverridable() -> item,itemRange,false + | FindMemberFlag.IgnoreOverrides,_ -> + let _,item,_,itemRange = resolveExpr FindMemberFlag.PreferOverrides + item, itemRange,true + let sendToSink refinedItem = + let staticOnly = thisIsActuallyATyAppNotAnExpr + let refinedItem = FilterMethodGroups ncenv itemRange refinedItem staticOnly + let unrefinedItem = FilterMethodGroups ncenv itemRange unrefinedItem staticOnly + CallNameResolutionSink sink (itemRange, nenv, refinedItem, unrefinedItem, ItemOccurence.Use, nenv.DisplayEnv, ad) + match overrides,NeedsOverloadResolution unrefinedItem with + | false, true -> + AfterOverloadResolution.SendToSink(sendToSink, IfOverloadResolutionFails(fun () -> sendToSink unrefinedItem)) + | true, true -> + AfterOverloadResolution.ReplaceWithOverrideAndSendToSink(unrefinedItem,sendToSink, IfOverloadResolutionFails(fun () -> sendToSink unrefinedItem)) + | _ , false -> + sendToSink unrefinedItem + AfterOverloadResolution.DoNothing item, itemRange, rest, afterOverloadResolution - //------------------------------------------------------------------------- // Given an nenv resolve partial paths to sets of names, used by interactive // environments (Visual Studio) diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index 87b440ae692..41cd6ecbd1a 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -285,9 +285,13 @@ type internal TcResultsSinkImpl = /// An abstract type for reporting the results of name resolution and type checking, and which allows /// temporary suspension and/or redirection of reporting. type TcResultsSink = - { mutable CurrentSink : ITypecheckResultsSink option } - static member NoSink : TcResultsSink - static member WithSink : ITypecheckResultsSink -> TcResultsSink + { mutable CurrentSink : ITypecheckResultsSink } + +module internal TcResultsSink = + val NoSink : TcResultsSink + val WithSink : ITypecheckResultsSink -> TcResultsSink + +val internal NoOpTypecheckResultSink : ITypecheckResultsSink /// Temporarily redirect reporting of name resolution and type checking results val internal WithNewTypecheckResultsSink : ITypecheckResultsSink * TcResultsSink -> System.IDisposable diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 614ca668d87..e33334e8c2f 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -1495,14 +1495,14 @@ let MakeAndPublishVal cenv env (altActualParent,inSig,declKind,vrec,(ValScheme(i PublishValueDefn cenv env declKind vspec begin - match cenv.tcSink.CurrentSink with - | None -> () - | Some _ -> - if not vspec.IsCompilerGenerated && not (String.hasPrefix vspec.LogicalName "_") then - let nenv = AddFakeNamedValRefToNameEnv vspec.DisplayName env.NameEnv (mkLocalValRef vspec) - CallEnvSink cenv.tcSink (vspec.Range,nenv,env.eAccessRights) - let item = Item.Value(mkLocalValRef vspec) - CallNameResolutionSink cenv.tcSink (vspec.Range,nenv,item,item,ItemOccurence.Binding,env.DisplayEnv,env.eAccessRights) + if cenv.tcSink.CurrentSink <> NameResolution.NoOpTypecheckResultSink + && not vspec.IsCompilerGenerated + && not (String.hasPrefix vspec.LogicalName "_") then + + let nenv = AddFakeNamedValRefToNameEnv vspec.DisplayName env.NameEnv (mkLocalValRef vspec) + CallEnvSink cenv.tcSink (vspec.Range,nenv,env.eAccessRights) + let item = Item.Value(mkLocalValRef vspec) + CallNameResolutionSink cenv.tcSink (vspec.Range,nenv,item,item,ItemOccurence.Binding,env.DisplayEnv,env.eAccessRights) end vspec @@ -6641,34 +6641,31 @@ and TcObjectExpr cenv overallTy env tpenv (synObjTy,argopt,binds,extraImpls,mNew and TcConstStringExpr cenv overallTy env m tpenv s = if (AddCxTypeEqualsTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy cenv.g.string_ty) then - mkString cenv.g m s,tpenv + mkString cenv.g m s,tpenv else - let aty = NewInferenceType () - let bty = NewInferenceType () - let cty = NewInferenceType () - let dty = NewInferenceType () - let ety = NewInferenceType () - let ty' = mkPrintfFormatTy cenv.g aty bty cty dty ety - if (not (isObjTy cenv.g overallTy) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy ty') then - // Parse the format string to work out the phantom types - let source = match cenv.tcSink.CurrentSink with None -> None | Some sink -> sink.CurrentSource - let normalizedString = (s.Replace("\r\n", "\n").Replace("\r", "\n")) - - let (aty',ety'), specifierLocations = (try CheckFormatStrings.ParseFormatString m cenv.g source normalizedString bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString(s),m))) - - match cenv.tcSink.CurrentSink with - | None -> () - | Some sink -> + let aty = NewInferenceType () + let bty = NewInferenceType () + let cty = NewInferenceType () + let dty = NewInferenceType () + let ety = NewInferenceType () + let ty' = mkPrintfFormatTy cenv.g aty bty cty dty ety + if (not (isObjTy cenv.g overallTy) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy ty') then + // Parse the format string to work out the phantom types + let source = cenv.tcSink.CurrentSink.CurrentSource + let normalizedString = (s.Replace("\r\n", "\n").Replace("\r", "\n")) + + let (aty',ety'), specifierLocations = (try CheckFormatStrings.ParseFormatString m cenv.g source normalizedString bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString(s),m))) + for specifierLocation in specifierLocations do - sink.NotifyFormatSpecifierLocation specifierLocation - - UnifyTypes cenv env m aty aty' - UnifyTypes cenv env m ety ety' - mkCallNewFormat cenv.g m aty bty cty dty ety (mkString cenv.g m s),tpenv - else - UnifyTypes cenv env m overallTy cenv.g.string_ty - mkString cenv.g m s,tpenv - + cenv.tcSink.CurrentSink.NotifyFormatSpecifierLocation specifierLocation + + UnifyTypes cenv env m aty aty' + UnifyTypes cenv env m ety ety' + mkCallNewFormat cenv.g m aty bty cty dty ety (mkString cenv.g m s),tpenv + else + UnifyTypes cenv env m overallTy cenv.g.string_ty + mkString cenv.g m s,tpenv + //------------------------------------------------------------------------- // TcConstExpr //------------------------------------------------------------------------- From b67938ee1f56fe7496f2e94a7337074d75aad894 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sun, 15 Jan 2017 14:20:14 +0300 Subject: [PATCH 12/23] eliminate a list creation --- src/fsharp/NameResolution.fs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 5da2835b3c0..7b5485159a1 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -109,8 +109,9 @@ let ActivePatternElemsOfVal modref vspec = let ActivePatternElemsOfModuleOrNamespace (modref:ModuleOrNamespaceRef) : NameMap = let mtyp = modref.ModuleOrNamespaceType cacheOptRef mtyp.ActivePatternElemRefLookupTable (fun () -> - let aprefs = [ for x in mtyp.AllValsAndMembers do yield! ActivePatternElemsOfVal modref x ] - (Map.empty,aprefs) ||> List.fold (fun acc apref -> NameMap.add apref.Name apref acc) ) + mtyp.AllValsAndMembers + |> Seq.collect (ActivePatternElemsOfVal modref) + |> Seq.fold (fun acc apref -> NameMap.add apref.Name apref acc) Map.empty) //--------------------------------------------------------------------------- // Name Resolution Items From d9501f604399ec7123401f1bd1d9ed432ffe08c8 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sun, 15 Jan 2017 15:31:23 +0300 Subject: [PATCH 13/23] renaming --- src/fsharp/vs/service.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index 5c90a8721e0..3190b2cc9e5 100644 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -1134,7 +1134,7 @@ type TypeCheckInfo static let keywordTypes = Lexhelp.Keywords.keywordTypes - member x.GetSortedNameResolutionEnvironments() = GetEnvsByLine() + member x.GetNameResolutionEnvironmentsByLine() = GetEnvsByLine() member x.GetVisibleNamespacesAndModulesAtPosition(cursorPos: pos) : ModuleOrNamespaceRef list = let (nenv, ad), m = GetBestEnvForPos (GetEnvsByLine()) cursorPos @@ -2080,7 +2080,7 @@ type FSharpCheckFileResults(errors: FSharpErrorInfo[], scopeOptX: TypeCheckInfo reactorOp "GetDeclarations" [| |] (fun scope -> scope.GetVisibleNamespacesAndModulesAtPosition(pos) |> List.toArray) member info.GetNameResolutionEnvironmentsByLine() : Async []> = - reactorOp "IsRelativeNameResolvable" [||] (fun scope -> scope.GetSortedNameResolutionEnvironments()) + reactorOp "IsRelativeNameResolvable" [||] (fun scope -> scope.GetNameResolutionEnvironmentsByLine()) member info.IsRelativeNameResolvable(pos: pos, plid: string list, item: Item, nenvsByLine: ResizeArray []) : Async = reactorOp "IsRelativeNameResolvable" true (fun scope -> scope.IsRelativeNameResolvable(pos, plid, item, nenvsByLine)) From 0295e8e9293324d43b0b91c0412c2a724ea0bc0d Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sun, 15 Jan 2017 15:31:48 +0300 Subject: [PATCH 14/23] optimize ValRef --- src/fsharp/tast.fs | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index 61bfe6b1d3e..a58876cb316 100755 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -3020,15 +3020,14 @@ and mutable binding: NonNullSlot /// Indicates a reference to something bound in another CCU nlr: NonLocalValOrMemberRef } - member x.IsLocalRef = match box x.nlr with null -> true | _ -> false - member x.IsResolved = match box x.binding with null -> false | _ -> true + member x.IsLocalRef = obj.ReferenceEquals(x.nlr, null) + member x.IsResolved = not (obj.ReferenceEquals(x.binding, null)) member x.PrivateTarget = x.binding member x.ResolvedTarget = x.binding /// Dereference the ValRef to a Val. member vr.Deref = - match box vr.binding with - | null -> + if obj.ReferenceEquals(vr.binding, null) then let res = let nlr = vr.nlr let e = nlr.EnclosingEntity.Deref @@ -3038,12 +3037,11 @@ and | Some h -> h vr.binding <- nullableSlotFull res res - | _ -> vr.binding + else vr.binding /// Dereference the ValRef to a Val option. member vr.TryDeref = - match box vr.binding with - | null -> + if obj.ReferenceEquals(vr.binding, null) then let resOpt = vr.nlr.EnclosingEntity.TryDeref |> Option.bind (fun e -> e.ModuleOrNamespaceType.TryLinkVal(vr.nlr.EnclosingEntity.nlr.Ccu, vr.nlr.ItemKey)) @@ -3052,8 +3050,7 @@ and | Some res -> vr.binding <- nullableSlotFull res resOpt - | _ -> - Some vr.binding + else Some vr.binding /// The type of the value. May be a TType_forall for a generic value. /// May be a type variable or type containing type variables during type inference. From 8581466f0fe591a5f72c64b450c18ba0e207167a Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sun, 15 Jan 2017 16:34:32 +0300 Subject: [PATCH 15/23] small optimizations --- src/fsharp/NameResolution.fs | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 7b5485159a1..640c30e6168 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1322,8 +1322,7 @@ let ItemsAreEffectivelyEqual g orig other = (id1.idText = id2.idText && id1.idRange = id2.idRange) | (Item.ArgName (id,_, _), ValUse vref) | (ValUse vref, Item.ArgName (id, _, _)) -> - (id.idText = vref.DisplayName && - (id.idRange = vref.DefinitionRange || id.idRange = vref.SigRange)) + ((id.idRange = vref.DefinitionRange || id.idRange = vref.SigRange) && id.idText = vref.DisplayName) | ILFieldUse f1, ILFieldUse f2 -> ILFieldInfo.ILFieldInfosUseIdenticalDefinitions f1 f2 @@ -1911,7 +1910,7 @@ let DecodeFSharpEvent (pinfos:PropInfo list) ad g (ncenv:NameResolver) m = | _ -> // FOUND PROPERTY-AS-EVENT BUT DIDN'T FIND CORRESPONDING ADD/REMOVE METHODS Some(Item.Property (nm,pinfos)) - | pinfo::_ when not (isNil pinfos) -> + | pinfo :: _ -> let nm = CoreDisplayName(pinfo) Some(Item.Property (nm,pinfos)) | _ -> @@ -1924,8 +1923,7 @@ let GetRecordLabelsForType g nenv typ = nenv.eFieldLabels |> Seq.filter (fun kv -> kv.Value - |> List.map (fun r -> r.TyconRef.DisplayName) - |> List.exists ((=) typeName)) + |> List.exists (fun r -> r.TyconRef.DisplayName = typeName)) |> Seq.map (fun kv -> kv.Key) |> Set.ofSeq else From d3c1e726296cd1c6c85208fa497b835cc3427cf9 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sun, 15 Jan 2017 21:03:13 +0300 Subject: [PATCH 16/23] make Ident a struct --- src/fsharp/ast.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fsharp/ast.fs b/src/fsharp/ast.fs index b1fc467e48f..bb163737f5f 100644 --- a/src/fsharp/ast.fs +++ b/src/fsharp/ast.fs @@ -135,9 +135,9 @@ type ParserDetail = // PERFORMANCE: consider making this a struct. [] -[] +[] [] -type Ident (text,range) = +type Ident (text: string, range: range) = member x.idText = text member x.idRange = range override x.ToString() = text From e2b8b10916edbc46166a3f503c1eca7500cf1808 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sun, 15 Jan 2017 21:03:31 +0300 Subject: [PATCH 17/23] add MaybeLazy --- src/fsharp/CompileOps.fs | 2 +- src/fsharp/Optimizer.fs | 2 +- src/fsharp/TastOps.fs | 15 ++++++--------- src/fsharp/TastPickle.fs | 13 +++++++++---- src/fsharp/TypeChecker.fs | 20 ++++++++++---------- src/fsharp/import.fs | 4 ++-- src/fsharp/tast.fs | 25 ++++++++++++++++++------- 7 files changed, 47 insertions(+), 34 deletions(-) diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index a1299491e9b..0573f249e94 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -3953,7 +3953,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti | None -> // Build up the artificial namespace if there is not a real one. let cpath = CompPath(ILScopeRef.Local, injectedNamspace |> List.rev |> List.map (fun n -> (n,ModuleOrNamespaceKind.Namespace)) ) - let newNamespace = NewModuleOrNamespace (Some cpath) taccessPublic (ident(next,rangeStartup)) XmlDoc.Empty [] (notlazy (NewEmptyModuleOrNamespaceType Namespace)) + let newNamespace = NewModuleOrNamespace (Some cpath) taccessPublic (ident(next,rangeStartup)) XmlDoc.Empty [] (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType Namespace)) entity.ModuleOrNamespaceType.AddModuleOrNamespaceByMutation(newNamespace) tcImports.InjectProvidedNamespaceOrTypeIntoEntity (typeProviderEnvironment, tcConfig, m, newNamespace, next::injectedNamspace, rest, provider, st) | [] -> diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index cdcdc4648c7..6105579238a 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -3084,7 +3084,7 @@ and OptimizeModuleExpr cenv env x = mty and elimModSpec (mspec:ModuleOrNamespace) = let mtyp = elimModTy mspec.ModuleOrNamespaceType - mspec.Data.entity_modul_contents <- notlazy mtyp + mspec.Data.entity_modul_contents <- MaybeLazy.Strict mtyp let rec elimModDef x = match x with diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index f7d91a6f6dc..15705a51189 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -980,7 +980,7 @@ let ensureCcuHasModuleOrNamespaceAtPath (ccu:CcuThunk) path (CompPath(_,cpath)) | (hpath::tpath),((_,mkind)::tcpath) -> let modName = hpath.idText if not (Map.containsKey modName mtype.AllEntitiesByCompiledAndLogicalMangledNames) then - let smodul = NewModuleOrNamespace (Some(CompPath(scoref,prior_cpath))) taccessPublic hpath xml [] (notlazy (NewEmptyModuleOrNamespaceType mkind)) + let smodul = NewModuleOrNamespace (Some(CompPath(scoref,prior_cpath))) taccessPublic hpath xml [] (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType mkind)) mtype.AddModuleOrNamespaceByMutation(smodul); let modul = Map.find modName mtype.AllEntitiesByCompiledAndLogicalMangledNames loop (prior_cpath@[(modName,Namespace)]) tpath tcpath modul @@ -3566,7 +3566,7 @@ end //-------------------------------------------------------------------------- let wrapModuleOrNamespaceType id cpath mtyp = - NewModuleOrNamespace (Some cpath) taccessPublic id XmlDoc.Empty [] (notlazy mtyp) + NewModuleOrNamespace (Some cpath) taccessPublic id XmlDoc.Empty [] (MaybeLazy.Strict mtyp) let wrapModuleOrNamespaceTypeInNamespace id cpath mtyp = let mspec = wrapModuleOrNamespaceType id cpath mtyp @@ -4972,9 +4972,8 @@ and copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs = tcd'.entity_tycon_repr <- tcd.entity_tycon_repr |> remapTyconRepr g tmenvinner2; tcd'.entity_tycon_abbrev <- tcd.entity_tycon_abbrev |> Option.map (remapType tmenvinner2) ; tcd'.entity_tycon_tcaug <- tcd.entity_tycon_tcaug |> remapTyconAug tmenvinner2 ; - tcd'.entity_modul_contents <- notlazy (tcd.entity_modul_contents - |> Lazy.force - |> mapImmediateValsAndTycons lookupTycon lookupVal); + tcd'.entity_modul_contents <- MaybeLazy.Strict (tcd.entity_modul_contents.Value + |> mapImmediateValsAndTycons lookupTycon lookupVal); tcd'.entity_exn_info <- tcd.entity_exn_info |> remapTyconExnInfo g tmenvinner2) ; tycons',vs', tmenvinner @@ -7637,10 +7636,8 @@ let rec remapEntityDataToNonLocal g tmenv (d: EntityData) = entity_tycon_abbrev = d.entity_tycon_abbrev |> Option.map (remapType tmenvinner) ; entity_tycon_tcaug = d.entity_tycon_tcaug |> remapTyconAug tmenvinner ; entity_modul_contents = - notlazy (d.entity_modul_contents - |> Lazy.force - |> mapImmediateValsAndTycons (remapTyconToNonLocal g tmenv) - (remapValToNonLocal g tmenv)); + MaybeLazy.Strict (d.entity_modul_contents.Value + |> mapImmediateValsAndTycons (remapTyconToNonLocal g tmenv) (remapValToNonLocal g tmenv)); entity_exn_info = d.entity_exn_info |> remapTyconExnInfo g tmenvinner} and remapTyconToNonLocal g tmenv x = diff --git a/src/fsharp/TastPickle.fs b/src/fsharp/TastPickle.fs index 0392ea8c292..84da20687ca 100755 --- a/src/fsharp/TastPickle.fs +++ b/src/fsharp/TastPickle.fs @@ -436,8 +436,7 @@ let p_option f x st = // Pickle lazy values in such a way that they can, in some future F# compiler version, be read back // lazily. However, a lazy reader is not used in this version because the value may contain the definitions of some // OSGN nodes. -let p_lazy p x st = - let v = Lazy.force x +let private p_lazy_impl p v st = let fixupPos1 = st.os.Position // We fix these up after prim_p_int32 0 st; @@ -473,6 +472,12 @@ let p_lazy p x st = st.os.FixupInt32 fixupPos6 ovalsIdx1; st.os.FixupInt32 fixupPos7 ovalsIdx2 +let p_lazy p x st = + p_lazy_impl p (Lazy.force x) st + +let p_maybe_lazy p (x: MaybeLazy<_>) st = + p_lazy_impl p x.Value st + let p_hole () = let h = ref (None : 'T pickler option) (fun f -> h := Some f),(fun x st -> match !h with Some f -> f x st | None -> pfailwith st "p_hole: unfilled hole") @@ -1727,7 +1732,7 @@ and p_entity_spec_data (x:EntityData) st = p_kind x.entity_kind st p_int64 (x.entity_flags.PickledBits ||| (if flagBit then EntityFlags.ReservedBitForPickleFormatTyconReprFlag else 0L)) st p_option p_cpath x.entity_cpath st - p_lazy p_modul_typ x.entity_modul_contents st + p_maybe_lazy p_modul_typ x.entity_modul_contents st p_exnc_repr x.entity_exn_info st p_space 1 space st @@ -2012,7 +2017,7 @@ and u_entity_spec_data st : EntityData = entity_kind=x10b; entity_flags=EntityFlags(x11); entity_cpath=x12; - entity_modul_contents= x13; + entity_modul_contents=MaybeLazy.Lazy x13; entity_exn_info=x14; entity_il_repr_cache=newCache(); } diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index e33334e8c2f..9049ab383be 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -1289,7 +1289,7 @@ let UpdateAccModuleOrNamespaceType cenv env f = if cenv.compilingCanonicalFslibModuleType then let nleref = mkNonLocalEntityRef cenv.topCcu (arrPathOfLid env.ePath) let modul = nleref.Deref - modul.Data.entity_modul_contents <- notlazy (f true modul.ModuleOrNamespaceType) + modul.Data.entity_modul_contents <- MaybeLazy.Strict (f true modul.ModuleOrNamespaceType) SetCurrAccumulatedModuleOrNamespaceType env (f false (GetCurrAccumulatedModuleOrNamespaceType env)) let PublishModuleDefn cenv env mspec = @@ -13326,13 +13326,13 @@ module MutRecBindingChecking = let TcMutRecDefns_UpdateNSContents mutRecNSInfo = match mutRecNSInfo with | Some (Some (mspecNS: ModuleOrNamespace), mtypeAcc) -> - mspecNS.Data.entity_modul_contents <- notlazy !mtypeAcc + mspecNS.Data.entity_modul_contents <- MaybeLazy.Strict !mtypeAcc | _ -> () /// Updates the types of the modules to contain the contents so far let TcMutRecDefns_UpdateModuleContents mutRecNSInfo defns = defns |> MutRecShapes.iterModules (fun (MutRecDefnsPhase2DataForModule (mtypeAcc, mspec), _) -> - mspec.Data.entity_modul_contents <- notlazy !mtypeAcc) + mspec.Data.entity_modul_contents <- MaybeLazy.Strict !mtypeAcc) TcMutRecDefns_UpdateNSContents mutRecNSInfo @@ -14285,7 +14285,7 @@ module EstablishTypeDefinitionCores = CheckNamespaceModuleOrTypeName cenv.g id let envForDecls, mtypeAcc = MakeInnerEnv envInitial id modKind - let mspec = NewModuleOrNamespace (Some envInitial.eCompPath) vis id (xml.ToXmlDoc()) modAttrs (notlazy (NewEmptyModuleOrNamespaceType modKind)) + let mspec = NewModuleOrNamespace (Some envInitial.eCompPath) vis id (xml.ToXmlDoc()) modAttrs (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType modKind)) let innerParent = Parent (mkLocalModRef mspec) let typeNames = TypeNamesInMutRecDecls compDecls MutRecDefnsPhase2DataForModule (mtypeAcc, mspec), (innerParent, typeNames, envForDecls) @@ -14326,7 +14326,7 @@ module EstablishTypeDefinitionCores = let visOfRepr,_ = ComputeAccessAndCompPath env None id.idRange synVisOfRepr None parent let visOfRepr = combineAccess vis visOfRepr // If we supported nested types and modules then additions would be needed here - let lmtyp = notlazy (NewEmptyModuleOrNamespaceType ModuleOrType) + let lmtyp = MaybeLazy.Strict (NewEmptyModuleOrNamespaceType ModuleOrType) NewTycon(cpath, id.idText, id.idRange, vis, visOfRepr, TyparKind.Type, LazyWithContext.NotLazy checkedTypars, doc.ToXmlDoc(), preferPostfix, preEstablishedHasDefaultCtor, hasSelfReferentialCtor, lmtyp) @@ -16039,11 +16039,11 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS // Now typecheck the signature, accumulating and then recording the submodule description. let id = ident (modName, id.idRange) - let mspec = NewModuleOrNamespace (Some env.eCompPath) vis id (xml.ToXmlDoc()) attribs (notlazy (NewEmptyModuleOrNamespaceType modKind)) + let mspec = NewModuleOrNamespace (Some env.eCompPath) vis id (xml.ToXmlDoc()) attribs (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType modKind)) let! (mtyp,_) = TcModuleOrNamespaceSignatureElementsNonMutRec cenv (Parent (mkLocalModRef mspec)) env (id,modKind,mdefs,m,xml) - mspec.Data.entity_modul_contents <- notlazy mtyp + mspec.Data.entity_modul_contents <- MaybeLazy.Strict mtyp let scopem = unionRanges m endm PublishModuleDefn cenv env mspec let env = AddLocalSubModuleAndReport cenv.tcSink scopem cenv.g cenv.amap m env mspec @@ -16359,13 +16359,13 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv:cenv) parent typeNames scopem // 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 - let mspec = NewModuleOrNamespace (Some env.eCompPath) vis id (xml.ToXmlDoc()) modAttrs (notlazy (NewEmptyModuleOrNamespaceType modKind)) + let mspec = NewModuleOrNamespace (Some env.eCompPath) vis id (xml.ToXmlDoc()) modAttrs (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType modKind)) // Now typecheck. let! mexpr, topAttrsNew, envAtEnd = TcModuleOrNamespaceElements cenv (Parent (mkLocalModRef mspec)) endm envForModule xml None mdefs // Get the inferred type of the decls and record it in the mspec. - mspec.Data.entity_modul_contents <- notlazy !mtypeAcc + mspec.Data.entity_modul_contents <- MaybeLazy.Strict !mtypeAcc let modDefn = TMDefRec(false,[],[ModuleOrNamespaceBinding.Module(mspec,mexpr)],m) PublishModuleDefn cenv env mspec let env = AddLocalSubModuleAndReport cenv.tcSink scopem cenv.g cenv.amap m env mspec @@ -16552,7 +16552,7 @@ and TcMutRecDefsFinish cenv defs m = binds |> List.map ModuleOrNamespaceBinding.Binding | MutRecShape.Module ((MutRecDefnsPhase2DataForModule(mtypeAcc, mspec), _),mdefs) -> let mexpr = TcMutRecDefsFinish cenv mdefs m - mspec.Data.entity_modul_contents <- notlazy !mtypeAcc + mspec.Data.entity_modul_contents <- MaybeLazy.Strict !mtypeAcc [ ModuleOrNamespaceBinding.Module(mspec,mexpr) ]) TMDefRec(true,tycons,binds,m) diff --git a/src/fsharp/import.fs b/src/fsharp/import.fs index c0bca3ec1e0..329ac1515a4 100644 --- a/src/fsharp/import.fs +++ b/src/fsharp/import.fs @@ -436,7 +436,7 @@ let rec ImportILTypeDef amap m scoref (cpath:CompilationPath) enc nm (tdef:ILTyp // Make sure we reraise the original exception one occurs - see findOriginalException. (LazyWithContext.Create((fun m -> ImportILGenericParameters amap m scoref [] tdef.GenericParams), ErrorLogger.findOriginalException)) (scoref,enc,tdef) - lazyModuleOrNamespaceTypeForNestedTypes + (MaybeLazy.Lazy lazyModuleOrNamespaceTypeForNestedTypes) /// Import a list of (possibly nested) IL types as a new ModuleOrNamespaceType node @@ -455,7 +455,7 @@ and ImportILTypeDefList amap m (cpath:CompilationPath) enc items = |> multisetDiscriminateAndMap (fun n tgs -> let modty = lazy (ImportILTypeDefList amap m (cpath.NestedCompPath n Namespace) enc tgs) - NewModuleOrNamespace (Some cpath) taccessPublic (mkSynId m n) XmlDoc.Empty [] modty) + NewModuleOrNamespace (Some cpath) taccessPublic (mkSynId m n) XmlDoc.Empty [] (MaybeLazy.Lazy modty)) (fun (n,info:Lazy<_>) -> let (scoref2,_,lazyTypeDef:Lazy) = info.Force() ImportILTypeDef amap m scoref2 cpath enc n (lazyTypeDef.Force())) diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index a58876cb316..c4a2e7908f4 100755 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -970,6 +970,17 @@ type Entity = /// Sets the structness of a record or union type definition member x.SetIsStructRecordOrUnion b = let x = x.Data in let flags = x.entity_flags in x.entity_flags <- EntityFlags(flags.IsPrefixDisplay, flags.IsModuleOrNamespace, flags.PreEstablishedHasDefaultConstructor, flags.HasSelfReferentialConstructor, b) +and [] MaybeLazy<'T> = + | Strict of 'T + | Lazy of Lazy<'T> + member this.Value : 'T = + match this with + | Strict x -> x + | Lazy x -> x.Value + member this.Force() : 'T = + match this with + | Strict x -> x + | Lazy x -> x.Force() and [] @@ -1033,7 +1044,7 @@ and // // MUTABILITY: only used during creation and remapping of tycons and // when compiling fslib to fixup compiler forward references to internal items - mutable entity_modul_contents: Lazy + mutable entity_modul_contents: MaybeLazy /// The declared documentation for the type or module entity_xmldoc : XmlDoc @@ -1745,7 +1756,7 @@ and Construct = entity_tycon_repr_accessibility = TAccess([]) entity_exn_info=TExnNone entity_tycon_tcaug=TyconAugmentation.Create() - entity_modul_contents = lazy new ModuleOrNamespaceType(Namespace, QueueList.ofList [], QueueList.ofList []) + entity_modul_contents = MaybeLazy.Lazy (lazy new ModuleOrNamespaceType(Namespace, QueueList.ofList [], QueueList.ofList [])) // Generated types get internal accessibility entity_accessiblity= access entity_xmldoc = XmlDoc [||] // fetched on demand via est.fs API @@ -2596,7 +2607,7 @@ and NonLocalEntityRef = Construct.NewModuleOrNamespace (Some cpath) (TAccess []) (ident(path.[k],m)) XmlDoc.Empty [] - (notlazy (Construct.NewEmptyModuleOrNamespaceType Namespace)) + (MaybeLazy.Strict (Construct.NewEmptyModuleOrNamespaceType Namespace)) entity.ModuleOrNamespaceType.AddModuleOrNamespaceByMutation(newEntity) injectNamespacesFromIToJ newEntity (k+1) let newEntity = injectNamespacesFromIToJ entity i @@ -4606,7 +4617,7 @@ let NewExn cpath (id:Ident) access repr attribs doc = entity_pubpath=cpath |> Option.map (fun (cp:CompilationPath) -> cp.NestedPublicPath id) entity_accessiblity=access entity_tycon_repr_accessibility=access - entity_modul_contents = notlazy (NewEmptyModuleOrNamespaceType ModuleOrType) + entity_modul_contents = MaybeLazy.Strict (NewEmptyModuleOrNamespaceType ModuleOrType) entity_cpath= cpath entity_typars=LazyWithContext.NotLazy [] entity_tycon_abbrev = None @@ -4694,7 +4705,7 @@ let NewVal (logicalName:string,m:range,compiledName,ty,isMutable,isCompGen,arity let NewCcuContents sref m nm mty = - NewModuleOrNamespace (Some(CompPath(sref,[]))) taccessPublic (ident(nm,m)) XmlDoc.Empty [] (notlazy mty) + NewModuleOrNamespace (Some(CompPath(sref,[]))) taccessPublic (ident(nm,m)) XmlDoc.Empty [] (MaybeLazy.Strict mty) //-------------------------------------------------------------------------- @@ -4716,7 +4727,7 @@ let NewModifiedTycon f (orig:Tycon) = /// contents of the module. let NewModifiedModuleOrNamespace f orig = orig |> NewModifiedTycon (fun d -> - { d with entity_modul_contents = notlazy (f (d.entity_modul_contents.Force())) }) + { d with entity_modul_contents = MaybeLazy.Strict (f (d.entity_modul_contents.Force())) }) /// Create a Val based on an existing one using the function 'f'. /// We require that we be given the parent for the new Val. @@ -4771,7 +4782,7 @@ let CombineCcuContentFragments m l = { data1 with entity_xmldoc = XmlDoc.Merge entity1.XmlDoc entity2.XmlDoc entity_attribs = entity1.Attribs @ entity2.Attribs - entity_modul_contents=lazy (CombineModuleOrNamespaceTypes (path@[entity2.DemangledModuleOrNamespaceName]) entity2.Range entity1.ModuleOrNamespaceType entity2.ModuleOrNamespaceType) }) + entity_modul_contents = MaybeLazy.Lazy (lazy (CombineModuleOrNamespaceTypes (path@[entity2.DemangledModuleOrNamespaceName]) entity2.Range entity1.ModuleOrNamespaceType entity2.ModuleOrNamespaceType)) }) | false,false -> error(Error(FSComp.SR.tastDuplicateTypeDefinitionInAssembly(entity2.LogicalName, textOfPath path),entity2.Range)) | _,_ -> From 8cb75678bafc0671ddb2c38e49b10031e2c3489f Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Mon, 16 Jan 2017 08:55:19 +0300 Subject: [PATCH 18/23] SimplifyNameDiagnosticAnalyzer should do semantic analysis, not syntax one --- .../Diagnostics/SimplifyNameDiagnosticAnalyzer.fs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs b/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs index aa51e4f429a..5ffa8e3f063 100644 --- a/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs @@ -44,8 +44,9 @@ type internal SimplifyNameDiagnosticAnalyzer() = static member LongIdentPropertyKey = "FullName" override __.SupportedDiagnostics = ImmutableArray.Create Descriptor + override this.AnalyzeSyntaxAsync(_, _) = Task.FromResult ImmutableArray.Empty - override this.AnalyzeSyntaxAsync(document: Document, cancellationToken: CancellationToken) = + override this.AnalyzeSemanticsAsync(document: Document, cancellationToken: CancellationToken) = asyncMaybe { match getProjectInfoManager(document).TryGetOptionsForEditingDocumentOrProject(document) with | Some options -> @@ -124,8 +125,6 @@ type internal SimplifyNameDiagnosticAnalyzer() = |> Async.map (Option.defaultValue ImmutableArray.Empty) |> CommonRoslynHelpers.StartAsyncAsTask cancellationToken - override this.AnalyzeSemanticsAsync(_, _) = Task.FromResult ImmutableArray.Empty - interface IBuiltInAnalyzer with member __.OpenFileOnly _ = true member __.GetAnalyzerCategory() = DiagnosticAnalyzerCategory.SemanticDocumentAnalysis \ No newline at end of file From 2e636c8ed42c634aaedce8c4a837f4f66a2e3280 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sat, 28 Jan 2017 17:30:07 +0300 Subject: [PATCH 19/23] remove dead code --- src/fsharp/NameResolution.fs | 14 ------------- src/fsharp/NameResolution.fsi | 1 - src/fsharp/vs/service.fs | 20 +++++++++---------- src/fsharp/vs/service.fsi | 8 ++++---- .../SimplifyNameDiagnosticAnalyzer.fs | 2 +- 5 files changed, 14 insertions(+), 31 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 8799602a027..b85dcb5626a 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -3898,20 +3898,6 @@ and ResolvePartialLongIdentToClassOrRecdFieldsImpl (ncenv: NameResolver) (nenv: | _-> [] modsOrNs @ qualifiedFields -let GetVisibleNamespacesAndModulesAtPoint (ncenv: NameResolver) (nenv: NameResolutionEnv) m ad = - let ilTyconNames = - nenv.TyconsByAccessNames(FullyQualifiedFlag.OpenQualified).Values - |> List.choose (fun tyconRef -> if tyconRef.IsILTycon then Some tyconRef.DisplayName else None) - |> Set.ofList - - nenv.ModulesAndNamespaces(FullyQualifiedFlag.OpenQualified) - |> NameMultiMap.range - |> List.filter (fun x -> - let demangledName = x.DemangledModuleOrNamespaceName - IsInterestingModuleName demangledName && notFakeContainerModule ilTyconNames demangledName - && EntityRefContainsSomethingAccessible ncenv m ad x - && not (IsTyconUnseen ad ncenv.g ncenv.amap m x)) - (* Determining if an `Item` is resolvable at point by given `plid`. It's optimized by being lazy and early returning according to the given `Item` *) let private ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics typ (item: Item) : seq = diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index 41cd6ecbd1a..aeb85ffc229 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -422,6 +422,5 @@ type ResolveCompletionTargets = /// Resolve a (possibly incomplete) long identifier to a set of possible resolutions, qualified by type. val ResolveCompletionsInType : NameResolver -> NameResolutionEnv -> ResolveCompletionTargets -> Range.range -> AccessorDomain -> bool -> TType -> Item list -val GetVisibleNamespacesAndModulesAtPoint : NameResolver -> NameResolutionEnv -> range -> AccessorDomain -> ModuleOrNamespaceRef list val IsItemResolvable : NameResolver -> NameResolutionEnv -> range -> AccessorDomain -> string list -> Item -> bool \ No newline at end of file diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index c749287c3ff..4d98c5eaa2c 100644 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -1134,17 +1134,18 @@ type TypeCheckInfo static let keywordTypes = Lexhelp.Keywords.keywordTypes + /// Get `NameResolutionEnv`s indexed by line. member x.GetNameResolutionEnvironmentsByLine() = GetEnvsByLine() - member x.GetVisibleNamespacesAndModulesAtPosition(cursorPos: pos) : ModuleOrNamespaceRef list = - let (nenv, ad), m = GetBestEnvForPos (GetEnvsByLine()) cursorPos - NameResolution.GetVisibleNamespacesAndModulesAtPoint ncenv nenv m ad - - + /// Determines if a long ident is resolvable at a specific point. member x.IsRelativeNameResolvable(cursorPos: pos, plid: string list, item: Item, envsByLine: ResizeArray []) : bool = - /// Find items in the best naming environment. - let (nenv, ad), m = GetBestEnvForPos envsByLine cursorPos - NameResolution.IsItemResolvable ncenv nenv m ad plid item + ErrorScope.Protect + Range.range0 + (fun () -> + /// Find items in the best naming environment. + let (nenv, ad), m = GetBestEnvForPos envsByLine cursorPos + NameResolution.IsItemResolvable ncenv nenv m ad plid item) + (fun _ -> false) //let items = NameResolution.ResolvePartialLongIdent ncenv nenv (fun _ _ -> true) m ad plid true //items |> List.exists (ItemsAreEffectivelyEqual g item) @@ -2089,9 +2090,6 @@ type FSharpCheckFileResults(errors: FSharpErrorInfo[], scopeOptX: TypeCheckInfo if itemOcc <> ItemOccurence.RelatedText then yield FSharpSymbolUse(scope.TcGlobals, denv, symbol, itemOcc, m) |]) - member info.GetVisibleNamespacesAndModulesAtPoint(pos: pos) : Async = - reactorOp "GetVisibleNamespacesAndModulesAtPoint" [| |] (fun scope -> scope.GetVisibleNamespacesAndModulesAtPosition(pos) |> List.toArray) - member info.GetNameResolutionEnvironmentsByLine() : Async []> = reactorOp "IsRelativeNameResolvable" [||] (fun scope -> scope.GetNameResolutionEnvironmentsByLine()) diff --git a/src/fsharp/vs/service.fsi b/src/fsharp/vs/service.fsi index 4af3d2eee32..331a4f001f5 100755 --- a/src/fsharp/vs/service.fsi +++ b/src/fsharp/vs/service.fsi @@ -284,11 +284,11 @@ type internal FSharpCheckFileResults = /// Get the textual usages that resolved to the given symbol throughout the file member GetUsesOfSymbolInFile : symbol:FSharpSymbol -> Async - member GetVisibleNamespacesAndModulesAtPoint : pos -> Async - - member IsRelativeNameResolvable: cursorPos : pos * plid : string list * item: Item * ResizeArray [] -> Async - + /// Get `NameResolutionEnv`s indexed by line. member GetNameResolutionEnvironmentsByLine : unit -> Async []> + + /// Determines if a long ident is resolvable at a specific point. + member IsRelativeNameResolvable: cursorPos : pos * plid : string list * item: Item * ResizeArray [] -> Async /// A handle to the results of CheckFileInProject. [] diff --git a/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs b/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs index be0db071285..09522dbbe13 100644 --- a/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs @@ -59,7 +59,7 @@ type internal SimplifyNameDiagnosticAnalyzer() = | _ -> let! sourceText = document.GetTextAsync() let checker = getChecker document - let! _, _, checkResults = checker.ParseAndCheckDocument(document, options, sourceText = sourceText, allowStaleResults = true) + let! _, _, checkResults = checker.ParseAndCheckDocument(document, options, sourceText = sourceText, allowStaleResults = true) let! symbolUses = checkResults.GetAllUsesOfAllSymbolsInFile() |> liftAsync let mutable result = ResizeArray() let symbolUses = From f750dbb68c3302b2469d9728715805463117765f Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sat, 11 Feb 2017 11:25:29 +0300 Subject: [PATCH 20/23] fix after merge --- src/fsharp/TypeChecker.fs | 16 ++++++++-------- src/fsharp/vs/service.fs | 11 ++--------- 2 files changed, 10 insertions(+), 17 deletions(-) diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 7b8e2ff3d4b..f69feca9aaa 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -1534,14 +1534,14 @@ let MakeAndPublishVal cenv env (altActualParent,inSig,declKind,vrec,(ValScheme(i PublishValueDefn cenv env declKind vspec - if cenv.tcSink.CurrentSink <> NameResolution.NoOpTypecheckResultSink - && not vspec.IsCompilerGenerated - && not (String.hasPrefix vspec.LogicalName "_") then - - let nenv = AddFakeNamedValRefToNameEnv vspec.DisplayName env.NameEnv (mkLocalValRef vspec) - CallEnvSink cenv.tcSink (vspec.Range,nenv,env.eAccessRights) - let item = Item.Value(mkLocalValRef vspec) - CallNameResolutionSink cenv.tcSink (vspec.Range,nenv,item,item,ItemOccurence.Binding,env.DisplayEnv,env.eAccessRights) + if cenv.tcSink.CurrentSink <> NameResolution.NoOpTypecheckResultSink + && not vspec.IsCompilerGenerated + && not (String.hasPrefix vspec.LogicalName "_") then + + let nenv = AddFakeNamedValRefToNameEnv vspec.DisplayName env.NameEnv (mkLocalValRef vspec) + CallEnvSink cenv.tcSink (vspec.Range,nenv,env.eAccessRights) + let item = Item.Value(mkLocalValRef vspec) + CallNameResolutionSink cenv.tcSink (vspec.Range,nenv,item,item,ItemOccurence.Binding,env.DisplayEnv,env.eAccessRights) vspec diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index dfd9bb8669d..32962e5b5de 100644 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -2154,20 +2154,13 @@ type FSharpCheckFileResults(errors: FSharpErrorInfo[], scopeOptX: TypeCheckInfo member info.GetNameResolutionEnvironmentsByLine() : Async []> = reactorOp "IsRelativeNameResolvable" [||] (fun ctok scope -> - DoesNotRequireCompilerThreadTokenAndCouldPossiblyBeMadeConcurrent ctok - - scope.GetNameResolutionEnvironmentsByLine()) - DoesNotRequireCompilerThreadTokenAndCouldPossiblyBeMadeConcurrent ctok - - scope.GetVisibleNamespacesAndModulesAtPosition(pos) |> List.toArray) + scope.GetNameResolutionEnvironmentsByLine()) member info.IsRelativeNameResolvable(pos: pos, plid: string list, item: Item, nenvsByLine: ResizeArray []) : Async = reactorOp "IsRelativeNameResolvable" true (fun ctok scope -> - DoesNotRequireCompilerThreadTokenAndCouldPossiblyBeMadeConcurrent ctok - - scope.IsRelativeNameResolvable(pos, plid, item, nenvsByLine))) + scope.IsRelativeNameResolvable(pos, plid, item, nenvsByLine)) //---------------------------------------------------------------------------- // BackgroundCompiler From 6887a3343896055c2174e0bb180125388b25aabe Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sat, 11 Feb 2017 11:34:08 +0300 Subject: [PATCH 21/23] Revert "make CurrentSink non-optional" This reverts commit a2f791dceccf6e243232cf4858a7e49654a4c741. # Conflicts: # src/fsharp/TypeChecker.fs --- src/fsharp/NameResolution.fs | 103 +++++++++++++++++----------------- src/fsharp/NameResolution.fsi | 10 +--- src/fsharp/TypeChecker.fs | 65 +++++++++++---------- 3 files changed, 88 insertions(+), 90 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 1d84c7f467a..86841d43026 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1197,14 +1197,6 @@ type ITypecheckResultsSink = abstract NotifyNameResolution : pos * Item * Item * ItemOccurence * Tastops.DisplayEnv * NameResolutionEnv * AccessorDomain * range * bool -> unit abstract NotifyFormatSpecifierLocation : range -> unit abstract CurrentSource : string option - -let NoOpTypecheckResultSink = - { new ITypecheckResultsSink with - member __.NotifyEnvWithScope (_,_,_) = () - member __.NotifyExprHasType (_,_,_,_,_,_) = () - member __.NotifyNameResolution (_,_,_,_,_,_,_,_,_) = () - member __.NotifyFormatSpecifierLocation _ = () - member __.CurrentSource = None } let (|ValRefOfProp|_|) (pi : PropInfo) = pi.ArbitraryValRef let (|ValRefOfMeth|_|) (mi : MethInfo) = mi.ArbitraryValRef @@ -1478,40 +1470,46 @@ type TcResultsSinkImpl(g, ?source: string) = /// An abstract type for reporting the results of name resolution and type checking, and which allows /// temporary suspension and/or redirection of reporting. -type TcResultsSink = - { mutable CurrentSink : ITypecheckResultsSink } - -module TcResultsSink = - let NoSink = { CurrentSink = NoOpTypecheckResultSink } - let WithSink sink = { CurrentSink = sink } +type TcResultsSink = + { mutable CurrentSink : ITypecheckResultsSink option } + static member NoSink = { CurrentSink = None } + static member WithSink sink = { CurrentSink = Some sink } /// Temporarily redirect reporting of name resolution and type checking results let WithNewTypecheckResultsSink (newSink : ITypecheckResultsSink, sink:TcResultsSink) = let old = sink.CurrentSink - sink.CurrentSink <- newSink + sink.CurrentSink <- Some newSink { new System.IDisposable with member x.Dispose() = sink.CurrentSink <- old } /// Temporarily suspend reporting of name resolution and type checking results let TemporarilySuspendReportingTypecheckResultsToSink (sink:TcResultsSink) = let old = sink.CurrentSink - sink.CurrentSink <- NoOpTypecheckResultSink + sink.CurrentSink <- None { new System.IDisposable with member x.Dispose() = sink.CurrentSink <- old } /// Report the active name resolution environment for a specific source range let CallEnvSink (sink:TcResultsSink) (scopem,nenv,ad) = - sink.CurrentSink.NotifyEnvWithScope(scopem,nenv,ad) + match sink.CurrentSink with + | None -> () + | Some sink -> sink.NotifyEnvWithScope(scopem,nenv,ad) /// Report a specific name resolution at a source range let CallNameResolutionSink (sink:TcResultsSink) (m:range,nenv,item,itemMethodGroup,occurenceType,denv,ad) = - sink.CurrentSink.NotifyNameResolution(m.End,item,itemMethodGroup,occurenceType,denv,nenv,ad,m,false) + match sink.CurrentSink with + | None -> () + | Some sink -> sink.NotifyNameResolution(m.End,item,itemMethodGroup,occurenceType,denv,nenv,ad,m,false) let CallNameResolutionSinkReplacing (sink:TcResultsSink) (m:range,nenv,item,itemMethodGroup,occurenceType,denv,ad) = - sink.CurrentSink.NotifyNameResolution(m.End,item,itemMethodGroup,occurenceType,denv,nenv,ad,m,true) + match sink.CurrentSink with + | None -> () + | Some sink -> sink.NotifyNameResolution(m.End,item,itemMethodGroup,occurenceType,denv,nenv,ad,m,true) /// Report a specific expression typing at a source range let CallExprHasTypeSink (sink:TcResultsSink) (m:range,nenv,typ,denv,ad) = - sink.CurrentSink.NotifyExprHasType(m.End,typ,denv,nenv,ad,m) + match sink.CurrentSink with + | None -> () + | Some sink -> sink.NotifyExprHasType(m.End,typ,denv,nenv,ad,m) //------------------------------------------------------------------------- // Check inferability of type parameters in resolved items. @@ -3181,14 +3179,14 @@ let ResolveLongIdentAsExprAndComputeRange (sink:TcResultsSink) (ncenv:NameResolv if not isFakeIdents then CallNameResolutionSink sink (itemRange, nenv, refinedItem, item, ItemOccurence.Use, nenv.DisplayEnv, ad) let afterOverloadResolution = - if sink.CurrentSink = NoOpTypecheckResultSink then - AfterOverloadResolution.DoNothing - else - if NeedsOverloadResolution item then - AfterOverloadResolution.SendToSink(callSink, (fun () -> callSink item) |> IfOverloadResolutionFails) - else - callSink item - AfterOverloadResolution.DoNothing + match sink.CurrentSink with + | None -> AfterOverloadResolution.DoNothing + | Some _ -> + if NeedsOverloadResolution item then + AfterOverloadResolution.SendToSink(callSink, (fun () -> callSink item) |> IfOverloadResolutionFails) + else + callSink item + AfterOverloadResolution.DoNothing item, itemRange, rest, afterOverloadResolution let (|NonOverridable|_|) namedItem = @@ -3212,32 +3210,33 @@ let ResolveExprDotLongIdentAndComputeRange (sink:TcResultsSink) (ncenv:NameResol // Record the precise resolution of the field for intellisense/goto definition let afterOverloadResolution = - if sink.CurrentSink = NoOpTypecheckResultSink then - AfterOverloadResolution.DoNothing // do not retypecheck if nobody listens - else - // resolution for goto definition - let unrefinedItem,itemRange,overrides = - match findFlag, item with - | FindMemberFlag.PreferOverrides, _ - | _, NonOverridable() -> item,itemRange,false - | FindMemberFlag.IgnoreOverrides,_ -> - let _,item,_,itemRange = resolveExpr FindMemberFlag.PreferOverrides - item, itemRange,true - let sendToSink refinedItem = - let staticOnly = thisIsActuallyATyAppNotAnExpr - let refinedItem = FilterMethodGroups ncenv itemRange refinedItem staticOnly - let unrefinedItem = FilterMethodGroups ncenv itemRange unrefinedItem staticOnly - CallNameResolutionSink sink (itemRange, nenv, refinedItem, unrefinedItem, ItemOccurence.Use, nenv.DisplayEnv, ad) - match overrides,NeedsOverloadResolution unrefinedItem with - | false, true -> - AfterOverloadResolution.SendToSink(sendToSink, IfOverloadResolutionFails(fun () -> sendToSink unrefinedItem)) - | true, true -> - AfterOverloadResolution.ReplaceWithOverrideAndSendToSink(unrefinedItem,sendToSink, IfOverloadResolutionFails(fun () -> sendToSink unrefinedItem)) - | _ , false -> - sendToSink unrefinedItem - AfterOverloadResolution.DoNothing + match sink.CurrentSink with + | None -> AfterOverloadResolution.DoNothing // do not retypecheck if nobody listens + | Some _ -> + // resolution for goto definition + let unrefinedItem,itemRange,overrides = + match findFlag, item with + | FindMemberFlag.PreferOverrides, _ + | _, NonOverridable() -> item,itemRange,false + | FindMemberFlag.IgnoreOverrides,_ -> + let _,item,_,itemRange = resolveExpr FindMemberFlag.PreferOverrides + item, itemRange,true + let sendToSink refinedItem = + let staticOnly = thisIsActuallyATyAppNotAnExpr + let refinedItem = FilterMethodGroups ncenv itemRange refinedItem staticOnly + let unrefinedItem = FilterMethodGroups ncenv itemRange unrefinedItem staticOnly + CallNameResolutionSink sink (itemRange, nenv, refinedItem, unrefinedItem, ItemOccurence.Use, nenv.DisplayEnv, ad) + match overrides,NeedsOverloadResolution unrefinedItem with + | false, true -> + AfterOverloadResolution.SendToSink(sendToSink, IfOverloadResolutionFails(fun () -> sendToSink unrefinedItem)) + | true, true -> + AfterOverloadResolution.ReplaceWithOverrideAndSendToSink(unrefinedItem,sendToSink, IfOverloadResolutionFails(fun () -> sendToSink unrefinedItem)) + | _ , false -> + sendToSink unrefinedItem + AfterOverloadResolution.DoNothing item, itemRange, rest, afterOverloadResolution + //------------------------------------------------------------------------- // Given an nenv resolve partial paths to sets of names, used by interactive // environments (Visual Studio) diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index aeb85ffc229..f35feaf24dd 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -285,13 +285,9 @@ type internal TcResultsSinkImpl = /// An abstract type for reporting the results of name resolution and type checking, and which allows /// temporary suspension and/or redirection of reporting. type TcResultsSink = - { mutable CurrentSink : ITypecheckResultsSink } - -module internal TcResultsSink = - val NoSink : TcResultsSink - val WithSink : ITypecheckResultsSink -> TcResultsSink - -val internal NoOpTypecheckResultSink : ITypecheckResultsSink + { mutable CurrentSink : ITypecheckResultsSink option } + static member NoSink : TcResultsSink + static member WithSink : ITypecheckResultsSink -> TcResultsSink /// Temporarily redirect reporting of name resolution and type checking results val internal WithNewTypecheckResultsSink : ITypecheckResultsSink * TcResultsSink -> System.IDisposable diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index f69feca9aaa..effcb58451c 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -1534,14 +1534,14 @@ let MakeAndPublishVal cenv env (altActualParent,inSig,declKind,vrec,(ValScheme(i PublishValueDefn cenv env declKind vspec - if cenv.tcSink.CurrentSink <> NameResolution.NoOpTypecheckResultSink - && not vspec.IsCompilerGenerated - && not (String.hasPrefix vspec.LogicalName "_") then - - let nenv = AddFakeNamedValRefToNameEnv vspec.DisplayName env.NameEnv (mkLocalValRef vspec) - CallEnvSink cenv.tcSink (vspec.Range,nenv,env.eAccessRights) - let item = Item.Value(mkLocalValRef vspec) - CallNameResolutionSink cenv.tcSink (vspec.Range,nenv,item,item,ItemOccurence.Binding,env.DisplayEnv,env.eAccessRights) + match cenv.tcSink.CurrentSink with + | None -> () + | Some _ -> + if not vspec.IsCompilerGenerated && not (String.hasPrefix vspec.LogicalName "_") then + let nenv = AddFakeNamedValRefToNameEnv vspec.DisplayName env.NameEnv (mkLocalValRef vspec) + CallEnvSink cenv.tcSink (vspec.Range,nenv,env.eAccessRights) + let item = Item.Value(mkLocalValRef vspec) + CallNameResolutionSink cenv.tcSink (vspec.Range,nenv,item,item,ItemOccurence.Binding,env.DisplayEnv,env.eAccessRights) vspec @@ -6697,31 +6697,34 @@ and TcObjectExpr cenv overallTy env tpenv (synObjTy,argopt,binds,extraImpls,mNew and TcConstStringExpr cenv overallTy env m tpenv s = if (AddCxTypeEqualsTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy cenv.g.string_ty) then - mkString cenv.g m s,tpenv + mkString cenv.g m s,tpenv else - let aty = NewInferenceType () - let bty = NewInferenceType () - let cty = NewInferenceType () - let dty = NewInferenceType () - let ety = NewInferenceType () - let ty' = mkPrintfFormatTy cenv.g aty bty cty dty ety - if (not (isObjTy cenv.g overallTy) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy ty') then - // Parse the format string to work out the phantom types - let source = cenv.tcSink.CurrentSink.CurrentSource - let normalizedString = (s.Replace("\r\n", "\n").Replace("\r", "\n")) - - let (aty',ety'), specifierLocations = (try CheckFormatStrings.ParseFormatString m cenv.g source normalizedString bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString(s),m))) - - for specifierLocation in specifierLocations do - cenv.tcSink.CurrentSink.NotifyFormatSpecifierLocation specifierLocation - - UnifyTypes cenv env m aty aty' - UnifyTypes cenv env m ety ety' - mkCallNewFormat cenv.g m aty bty cty dty ety (mkString cenv.g m s),tpenv - else - UnifyTypes cenv env m overallTy cenv.g.string_ty - mkString cenv.g m s,tpenv + let aty = NewInferenceType () + let bty = NewInferenceType () + let cty = NewInferenceType () + let dty = NewInferenceType () + let ety = NewInferenceType () + let ty' = mkPrintfFormatTy cenv.g aty bty cty dty ety + if (not (isObjTy cenv.g overallTy) && AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy ty') then + // Parse the format string to work out the phantom types + let source = match cenv.tcSink.CurrentSink with None -> None | Some sink -> sink.CurrentSource + let normalizedString = (s.Replace("\r\n", "\n").Replace("\r", "\n")) + let (aty',ety'), specifierLocations = (try CheckFormatStrings.ParseFormatString m cenv.g source normalizedString bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString(s),m))) + + match cenv.tcSink.CurrentSink with + | None -> () + | Some sink -> + for specifierLocation in specifierLocations do + sink.NotifyFormatSpecifierLocation specifierLocation + + UnifyTypes cenv env m aty aty' + UnifyTypes cenv env m ety ety' + mkCallNewFormat cenv.g m aty bty cty dty ety (mkString cenv.g m s),tpenv + else + UnifyTypes cenv env m overallTy cenv.g.string_ty + mkString cenv.g m s,tpenv + //------------------------------------------------------------------------- // TcConstExpr //------------------------------------------------------------------------- From 69563dd5f0df83385f63cf95d166282d7cdce15c Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sat, 11 Feb 2017 12:07:27 +0300 Subject: [PATCH 22/23] Revert "optimize GetBestEnvForPos by indexing nameres environments (scopes) by line number" This reverts commit c8edcc36e699b745dc11d118d00d6020cad9e7c1. # Conflicts: # src/fsharp/vs/service.fs # src/fsharp/vs/service.fsi --- src/fsharp/vs/service.fs | 75 ++++++------------- src/fsharp/vs/service.fsi | 7 +- .../SimplifyNameDiagnosticAnalyzer.fs | 4 +- 3 files changed, 26 insertions(+), 60 deletions(-) diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index 32962e5b5de..51dcd689ad4 100644 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -542,20 +542,12 @@ type TypeCheckInfo let ncenv = new NameResolver(g,amap,infoReader,NameResolution.FakeInstantiationGenerator) /// Find the most precise naming environment for the given line and column - let GetBestEnvForPos (envsByLine: ResizeArray []) (cursorPos: pos) = + let GetBestEnvForPos cursorPos = - let getEnvsOnLine line = - if line < 0 then ResizeArray() - elif line > envsByLine.Length - 1 then sResolutions.CapturedEnvs - else envsByLine.[line] - - let envsOnLine = getEnvsOnLine cursorPos.Line - - // Find all scopes those contain given position let mutable bestSoFar = None // Find the most deeply nested enclosing scope that contains given position - envsOnLine |> ResizeArray.iter (fun (possm, env, ad) -> + sResolutions.CapturedEnvs |> ResizeArray.iter (fun (possm,env,ad) -> if rangeContainsPos possm cursorPos then match bestSoFar with | Some (bestm,_,_) -> @@ -572,40 +564,36 @@ type TypeCheckInfo // We guarantee to only refine to a more nested environment. It may not be strictly // the right environment, but will alwauys be at least as rich - let evnsOnLineAndPreviousLine = - let envs = getEnvsOnLine (cursorPos.Line - 1) - envs.AddRange(envsOnLine) - envs - - let mutable bestAlmostIncludedSoFar = None + let bestAlmostIncludedSoFar = ref None - evnsOnLineAndPreviousLine |> ResizeArray.iter (fun (possm, env, ad) -> + sResolutions.CapturedEnvs |> ResizeArray.iter (fun (possm,env,ad) -> // take only ranges that strictly do not include cursorPos (all ranges that touch cursorPos were processed during 'Strict Inclusion' part) - if not (posEq possm.End cursorPos) && rangeBeforePos possm cursorPos then + if rangeBeforePos possm cursorPos && not (posEq possm.End cursorPos) then let contained = match mostDeeplyNestedEnclosingScope with | Some (bestm,_,_) -> rangeContainsRange bestm possm | None -> true if contained then - match bestAlmostIncludedSoFar with - | Some (rightm: range,_,_) -> + match !bestAlmostIncludedSoFar with + | Some (rightm:range,_,_) -> if posGt possm.End rightm.End || (posEq possm.End rightm.End && posGt possm.Start rightm.Start) then - bestAlmostIncludedSoFar <- Some (possm,env,ad) - | _ -> bestAlmostIncludedSoFar <- Some (possm,env,ad)) + bestAlmostIncludedSoFar := Some (possm,env,ad) + | _ -> bestAlmostIncludedSoFar := Some (possm,env,ad)) let resEnv = - match bestAlmostIncludedSoFar with - | Some (_,env,ad) -> + match !bestAlmostIncludedSoFar with + | Some (_m,env,ad) -> env,ad | None -> match mostDeeplyNestedEnclosingScope with - | Some (_,env,ad) -> + | Some (_m,env,ad) -> env,ad | None -> - (sFallback, AccessibleFromSomeFSharpCode) + (sFallback,AccessibleFromSomeFSharpCode) let pm = mkRange mainInputFileName cursorPos cursorPos + resEnv,pm /// The items that come back from ResolveCompletionsInType are a bit @@ -825,17 +813,9 @@ type TypeCheckInfo if textChanged then GetPreciseCompletionListFromExprTypingsResult.NoneBecauseTypecheckIsStaleAndTextChanged else GetPreciseCompletionListFromExprTypingsResult.None - let GetEnvsByLine() : ResizeArray [] = - let maxLine = sResolutions.CapturedEnvs |> Seq.maxBy (fun (m, _, _) -> m.EndLine) |> fun (m, _, _) -> m.EndLine - let envsByLine = Array.init (maxLine + 1) (fun _ -> ResizeArray()) - for (m,_,_) as env in sResolutions.CapturedEnvs do - for line in m.StartLine..m.EndLine do - envsByLine.[line].Add env - envsByLine - /// Find items in the best naming environment. let GetEnvironmentLookupResolutions(cursorPos, plid, filterCtors, showObsolete) = - let (nenv,ad),m = GetBestEnvForPos (GetEnvsByLine()) cursorPos + let (nenv,ad),m = GetBestEnvForPos cursorPos let items = NameResolution.ResolvePartialLongIdent ncenv nenv (ConstraintSolver.IsApplicableMethApprox g amap m) m ad plid showObsolete let items = items |> RemoveDuplicateItems g let items = items |> RemoveExplicitlySuppressed g @@ -845,7 +825,7 @@ type TypeCheckInfo /// Find record fields in the best naming environment. let GetClassOrRecordFieldsEnvironmentLookupResolutions(cursorPos, plid, (_residue : string option)) = - let (nenv, ad),m = GetBestEnvForPos (GetEnvsByLine()) cursorPos + let (nenv, ad),m = GetBestEnvForPos cursorPos let items = NameResolution.ResolvePartialLongIdentToClassOrRecdFields ncenv nenv m ad plid false let items = items |> RemoveDuplicateItems g let items = items |> RemoveExplicitlySuppressed g @@ -1039,7 +1019,7 @@ type TypeCheckInfo /// Get the auto-complete items at a particular location. let GetDeclItemsForNamesAtPosition(ctok: CompilationThreadToken, parseResultsOpt: FSharpParseFileResults option, origLongIdentOpt: string list option, residueOpt:string option, line:int, lineStr:string, colAtEndOfNamesAndResidue, filterCtors, resolveOverloads, hasTextChangedSinceLastTypecheck: (obj * range -> bool)) = RequireCompilationThread ctok // the operations in this method need the reactor thread - + let loc = match colAtEndOfNamesAndResidue with | pastEndOfLine when pastEndOfLine >= lineStr.Length -> lineStr.Length @@ -1070,7 +1050,7 @@ type TypeCheckInfo // Completion at ' { XXX = ... } " | Some(CompletionContext.RecordField(RecordContext.New(plid, residue))) -> - Some(GetClassOrRecordFieldsEnvironmentLookupResolutions( mkPos line loc, plid, residue)) + Some(GetClassOrRecordFieldsEnvironmentLookupResolutions(mkPos line loc, plid, residue)) // Completion at ' { XXX = ... with ... } " | Some(CompletionContext.RecordField(RecordContext.CopyOnUpdate(r, (plid, residue)))) -> @@ -1157,18 +1137,16 @@ type TypeCheckInfo else items - static let keywordTypes = Lexhelp.Keywords.keywordTypes - /// Get `NameResolutionEnv`s indexed by line. - member x.GetNameResolutionEnvironmentsByLine() = GetEnvsByLine() + static let keywordTypes = Lexhelp.Keywords.keywordTypes + member x.IsRelativeNameResolvable(cursorPos: pos, plid: string list, item: Item) : bool = /// Determines if a long ident is resolvable at a specific point. - member x.IsRelativeNameResolvable(cursorPos: pos, plid: string list, item: Item, envsByLine: ResizeArray []) : bool = ErrorScope.Protect Range.range0 (fun () -> /// Find items in the best naming environment. - let (nenv, ad), m = GetBestEnvForPos envsByLine cursorPos + let (nenv, ad), m = GetBestEnvForPos cursorPos NameResolution.IsItemResolvable ncenv nenv m ad plid item) (fun _ -> false) @@ -2152,15 +2130,10 @@ type FSharpCheckFileResults(errors: FSharpErrorInfo[], scopeOptX: TypeCheckInfo if itemOcc <> ItemOccurence.RelatedText then yield FSharpSymbolUse(scope.TcGlobals, denv, symbol, itemOcc, m) |]) - member info.GetNameResolutionEnvironmentsByLine() : Async []> = - reactorOp "IsRelativeNameResolvable" [||] (fun ctok scope -> - DoesNotRequireCompilerThreadTokenAndCouldPossiblyBeMadeConcurrent ctok - scope.GetNameResolutionEnvironmentsByLine()) - - member info.IsRelativeNameResolvable(pos: pos, plid: string list, item: Item, nenvsByLine: ResizeArray []) : Async = - reactorOp "IsRelativeNameResolvable" true (fun ctok scope -> + member info.IsRelativeNameResolvable(pos: pos, plid: string list, item: Item) : Async = + reactorOp "IsRelativeNameResolvable" true (fun ctok scope -> DoesNotRequireCompilerThreadTokenAndCouldPossiblyBeMadeConcurrent ctok - scope.IsRelativeNameResolvable(pos, plid, item, nenvsByLine)) + scope.IsRelativeNameResolvable(pos, plid, item)) //---------------------------------------------------------------------------- // BackgroundCompiler diff --git a/src/fsharp/vs/service.fsi b/src/fsharp/vs/service.fsi index a7afba80e8f..257e03ce37e 100755 --- a/src/fsharp/vs/service.fsi +++ b/src/fsharp/vs/service.fsi @@ -14,7 +14,6 @@ open Microsoft.FSharp.Compiler.Range open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.NameResolution open Microsoft.FSharp.Compiler.CompileOps -open Microsoft.FSharp.Compiler.AccessibilityLogic open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library /// Represents one parameter for one method (or other item) in a group. @@ -299,12 +298,8 @@ type internal FSharpCheckFileResults = /// Get the textual usages that resolved to the given symbol throughout the file member GetUsesOfSymbolInFile : symbol:FSharpSymbol -> Async - /// Get `NameResolutionEnv`s indexed by line. - member GetNameResolutionEnvironmentsByLine : unit -> Async []> - /// Determines if a long ident is resolvable at a specific point. - member IsRelativeNameResolvable: cursorPos : pos * plid : string list * item: Item * ResizeArray [] -> Async - + member IsRelativeNameResolvable: cursorPos : pos * plid : string list * item: Item -> Async /// A handle to the results of CheckFileInProject. [] type internal FSharpCheckProjectResults = diff --git a/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs b/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs index 09522dbbe13..5eaa87e678d 100644 --- a/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs @@ -76,8 +76,6 @@ type internal SimplifyNameDiagnosticAnalyzer() = |> Array.groupBy (fun (symbolUse, _, plidStartCol, _) -> symbolUse.RangeAlternate.StartLine, plidStartCol) |> Array.map (fun (_, xs) -> xs |> Array.maxBy (fun (symbolUse, _, _, _) -> symbolUse.RangeAlternate.EndColumn)) - let! nenvsByLine = checkResults.GetNameResolutionEnvironmentsByLine() |> liftAsync - for symbolUse, plid, plidStartCol, name in symbolUses do if not symbolUse.IsFromDefinition then let posAtStartOfName = @@ -91,7 +89,7 @@ type internal SimplifyNameDiagnosticAnalyzer() = match rest with | [] -> return current | headIdent :: restPlid -> - let! res = checkResults.IsRelativeNameResolvable(posAtStartOfName, current, symbolUse.Symbol.Item, nenvsByLine) + let! res = checkResults.IsRelativeNameResolvable(posAtStartOfName, current, symbolUse.Symbol.Item) if res then return current else return! loop restPlid (headIdent :: current) } From 4766680aea0c20cf86fae5f3bdc08ae660cc50a7 Mon Sep 17 00:00:00 2001 From: Vasily Kirichenko Date: Sat, 11 Feb 2017 12:21:04 +0300 Subject: [PATCH 23/23] turn off SimplifyNameDiagnosticAnalyzer for now --- .../Diagnostics/SimplifyNameDiagnosticAnalyzer.fs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs b/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs index 5eaa87e678d..b9c006dd471 100644 --- a/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs @@ -19,7 +19,8 @@ open Microsoft.VisualStudio.FSharp.LanguageService type private TextVersionHash = int -[] +// TODO Turn it on when user settings dialog is ready to switch it on and off. +// [] type internal SimplifyNameDiagnosticAnalyzer() = inherit DocumentDiagnosticAnalyzer()